move shufflers to unmaintained

- unit test fails because of "in" vocab weirdness
db4
Doug Coleman 2008-04-26 00:59:03 -05:00
parent b7c1f9dbe8
commit 714b0ebc94
6 changed files with 60 additions and 0 deletions

View File

@ -0,0 +1 @@
Daniel Ehrenberg

View File

@ -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" } ;

View File

@ -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

View File

@ -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

View File

@ -0,0 +1 @@
Arbitrary stack shuffling operators of the form abc-cbab

View File

@ -0,0 +1 @@
extensions