parent
b7c1f9dbe8
commit
714b0ebc94
|
@ -0,0 +1 @@
|
|||
Daniel Ehrenberg
|
|
@ -0,0 +1,13 @@
|
|||
USING: help.syntax help.markup ;
|
||||
IN: shufflers
|
||||
|
||||
HELP: SHUFFLE:
|
||||
{ $syntax "SHUFFLE: alphabet #" }
|
||||
{ $values { "alphabet" "an alphabet of unique letters" } { "#" "the maximum length" } }
|
||||
{ $description "Defines stack shufflers of the form abc-bcba where 'abc' describes the inputs and 'bcba' describes the outputs. Given a stack of 1 2 3, this returns 2 3 2 1. The stack shufflers defined are put in the current vocab with the suffix '.shuffle' appended." }
|
||||
{ $examples
|
||||
"SHUFFLE: abcd 6\n"
|
||||
": 4drop abcd- ;\n"
|
||||
": 2over abcd-abcdab ;\n"
|
||||
": 2swap abcd-cdab ;\n"
|
||||
": 3dup abc-abcabc ;\n" } ;
|
|
@ -0,0 +1,8 @@
|
|||
USING: shufflers tools.test ;
|
||||
IN: shufflers.tests
|
||||
|
||||
SHUFFLE: abcd 4
|
||||
[ ] [ 1 2 3 4 abcd- ] unit-test
|
||||
[ 1 2 1 2 ] [ 1 2 3 abc-abab ] unit-test
|
||||
[ 4 3 2 1 ] [ 1 2 3 4 abcd-dcba ] unit-test
|
||||
[ 1 1 1 1 ] [ 1 a-aaaa ] unit-test
|
|
@ -0,0 +1,36 @@
|
|||
USING: kernel sequences words math math.functions arrays
|
||||
shuffle quotations parser math.parser strings namespaces
|
||||
splitting effects sequences.lib ;
|
||||
IN: shufflers
|
||||
|
||||
: shuffle>string ( names shuffle -- string )
|
||||
swap [ [ nth ] curry map ] curry map
|
||||
first2 "-" swap 3append >string ;
|
||||
|
||||
: make-shuffles ( max-out max-in -- shuffles )
|
||||
[ 1+ dup rot strings [ 2array ] with map ]
|
||||
with map concat ;
|
||||
|
||||
: shuffle>quot ( shuffle -- quot )
|
||||
[
|
||||
first2 2dup [ - ] with map
|
||||
reverse [ , \ npick , \ >r , ] each
|
||||
swap , \ ndrop , length [ \ r> , ] times
|
||||
] [ ] make ;
|
||||
|
||||
: put-effect ( word -- )
|
||||
dup word-name "-" split1
|
||||
[ >array [ 1string ] map ] bi@
|
||||
<effect> "declared-effect" set-word-prop ;
|
||||
|
||||
: in-shuffle ( -- ) in get ".shuffle" append set-in ;
|
||||
: out-shuffle ( -- ) in get ".shuffle" ?tail drop set-in ;
|
||||
|
||||
: define-shuffles ( names max-out -- )
|
||||
in-shuffle over length make-shuffles [
|
||||
[ shuffle>string create-in ] keep
|
||||
shuffle>quot dupd define put-effect
|
||||
] with each out-shuffle ;
|
||||
|
||||
: SHUFFLE:
|
||||
scan scan string>number define-shuffles ; parsing
|
|
@ -0,0 +1 @@
|
|||
Arbitrary stack shuffling operators of the form abc-cbab
|
|
@ -0,0 +1 @@
|
|||
extensions
|
Loading…
Reference in New Issue