1 ! Copyright (C) 2008 Jeff Bigot
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: kernel arrays sequences fry math combinators ;
7 ! : (combinations) ( seq -- seq ) [ 1 tail ] dip combinations ;
9 ! : prefix-each [ prefix ] curry map ; inline
11 ! : combinations ( seq n -- seqs )
13 ! { [ dup 0 = ] [ 2drop { { } } ] }
14 ! { [ over empty? ] [ 2drop { } ] }
16 ! [ [ 1 - (combinations) ] [ drop first ] 2bi prefix-each ]
17 ! [ (combinations) ] 2bi append
21 : columnize ( array -- array ) [ 1array ] map ; inline
23 : among ( array n -- array )
26 { [ over 1 = ] [ 3drop columnize ] }
27 { [ over 0 = ] [ 4drop { } ] }
28 { [ 2dup < ] [ 2drop [ 1 cut ] dip
29 [ 1 - among [ append ] with map ]
32 { [ 2dup = ] [ 3drop 1array ] }
33 { [ 2dup > ] [ 4drop { } ] }
37 : concat-nth ( seq1 seq2 -- seq )
38 [ nth append ] curry map-index ;
40 : do-cycle ( array -- array ) dup first suffix ;
42 : map-but ( seq i quot -- seq )
43 ! quot : ( seq x -- seq )
44 '[ _ = [ @ ] unless ] map-index ; inline