Functions added to sequences.lib; used in shufflers
parent
6b2ed35115
commit
4a29e2e707
|
@ -1,5 +1,5 @@
|
|||
USING: arrays kernel sequences sequences.lib math
|
||||
math.functions tools.test ;
|
||||
math.functions tools.test strings ;
|
||||
|
||||
[ 4 ] [ { 1 2 } [ sq ] [ * ] map-reduce ] unit-test
|
||||
[ 36 ] [ { 2 3 } [ sq ] [ * ] map-reduce ] unit-test
|
||||
|
@ -42,3 +42,7 @@ math.functions tools.test ;
|
|||
|
||||
[ { 1 9 25 } ] [ { 1 3 5 6 } [ sq ] [ even? ] map-until ] unit-test
|
||||
[ { 2 4 } ] [ { 2 4 1 3 } [ even? ] take-while ] unit-test
|
||||
|
||||
[ { { 0 0 } { 1 0 } { 0 1 } { 1 1 } } ] [ 2 2 exact-strings ] unit-test
|
||||
[ t ] [ "ab" 4 strings [ >string ] map "abab" swap member? ] unit-test
|
||||
[ { { } { 1 } { 2 } { 1 2 } } ] [ { 1 2 } power-set ] unit-test
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
USING: combinators.lib kernel sequences math namespaces
|
||||
random sequences.private shuffle ;
|
||||
USING: combinators.lib kernel sequences math namespaces assocs
|
||||
random sequences.private shuffle math.functions mirrors ;
|
||||
IN: sequences.lib
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
@ -74,3 +74,33 @@ IN: sequences.lib
|
|||
[ not ] compose
|
||||
[ find drop [ head-slice ] when* ] curry
|
||||
[ dup ] swap compose keep like ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
<PRIVATE
|
||||
: translate-string ( n alphabet out-len -- seq )
|
||||
[ drop /mod ] curry* map nip ;
|
||||
|
||||
: map-alphabet ( alphabet seq[seq] -- seq[seq] )
|
||||
[ [ swap nth ] curry* map ] curry* map ;
|
||||
|
||||
: exact-number-strings ( n out-len -- seqs )
|
||||
[ ^ ] 2keep [ translate-string ] 2curry map ;
|
||||
|
||||
: number-strings ( n max-length -- seqs )
|
||||
1+ [ exact-number-strings ] curry* map concat ;
|
||||
PRIVATE>
|
||||
|
||||
: exact-strings ( alphabet length -- seqs )
|
||||
>r dup length r> exact-number-strings map-alphabet ;
|
||||
|
||||
: strings ( alphabet length -- seqs )
|
||||
>r dup length r> number-strings map-alphabet ;
|
||||
|
||||
: nths ( nths seq -- subseq )
|
||||
! nths is a sequence of ones and zeroes
|
||||
>r [ length ] keep [ nth 1 = ] curry subset r>
|
||||
[ nth ] curry { } map-as ;
|
||||
|
||||
: power-set ( seq -- subsets )
|
||||
2 over length exact-number-strings swap [ nths ] curry map ;
|
||||
|
|
|
@ -1,25 +1,14 @@
|
|||
USING: kernel sequences words math math.functions arrays
|
||||
shuffle quotations parser math.parser strings namespaces
|
||||
splitting effects ;
|
||||
splitting effects sequences.lib ;
|
||||
IN: shufflers
|
||||
|
||||
: shuffle>string ( names shuffle -- string )
|
||||
swap [ [ nth ] curry map ] curry map
|
||||
first2 "-" swap 3append >string ;
|
||||
|
||||
: translate ( n alphabet out-len -- seq )
|
||||
[ drop /mod ] curry* map nip ;
|
||||
|
||||
: (combinations) ( alphabet out-len -- seq[seq] )
|
||||
[ ^ ] 2keep [ translate ] 2curry map ;
|
||||
|
||||
: combinations ( n max-out -- seq[seq] )
|
||||
! This returns a seq of length O(n^m)
|
||||
! where and m is max-out
|
||||
1+ [ (combinations) ] curry* map concat ;
|
||||
|
||||
: make-shuffles ( max-out max-in -- shuffles )
|
||||
[ 1+ dup rot combinations [ 2array ] curry* map ]
|
||||
[ 1+ dup rot strings [ 2array ] curry* map ]
|
||||
curry* map concat ;
|
||||
|
||||
: shuffle>quot ( shuffle -- quot )
|
||||
|
|
Loading…
Reference in New Issue