diff --git a/extra/sequences/lib/lib-tests.factor b/extra/sequences/lib/lib-tests.factor index 82e2b911c3..72cf9ad9c4 100644 --- a/extra/sequences/lib/lib-tests.factor +++ b/extra/sequences/lib/lib-tests.factor @@ -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 diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor index e090feffea..f5adccf445 100644 --- a/extra/sequences/lib/lib.factor +++ b/extra/sequences/lib/lib.factor @@ -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 ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + +: 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 ; diff --git a/extra/shufflers/shufflers.factor b/extra/shufflers/shufflers.factor index e0c5141029..95567da2ef 100644 --- a/extra/shufflers/shufflers.factor +++ b/extra/shufflers/shufflers.factor @@ -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 )