1 USING: accessors arrays combinators fry grouping
2 grouping.private kernel locals macros math math.ranges sequences
3 sequences.generalizations sequences.private vectors ;
7 : 2clump-map-as ( seq quot: ( elt1 elt2 -- newelt ) exemplar -- seq' )
8 [ dup 1 short tail-slice ] 2dip 2map-as ; inline
10 : 2clump-map ( seq quot: ( elt1 elt2 -- newelt ) -- seq' )
11 { } 2clump-map-as ; inline
13 : 3clump-map-as ( seq quot: ( elt1 elt2 elt3 -- newelt ) exemplar -- seq' )
15 dup [ 1 short tail-slice ] [ 2 short tail-slice ] bi
16 ] 2dip 3map-as ; inline
18 : 3clump-map ( seq quot: ( elt1 elt2 elt3 -- newelt ) -- seq' )
19 { } 3clump-map-as ; inline
21 MACRO: nclump-map-as ( seq quot exemplar n -- result )
22 [ nip [1,b) [ [ short tail-slice ] curry ] map swap ] 2keep
23 '[ _ dup _ cleave _ _ _ nmap-as ] ;
25 : nclump-map ( seq quot n -- result )
26 { } swap nclump-map-as ; inline
28 TUPLE: head-clumps seq ;
29 C: <head-clumps> head-clumps
30 M: head-clumps length seq>> length ;
31 M: head-clumps nth-unsafe seq>> swap 1 + head-slice ;
32 INSTANCE: head-clumps immutable-sequence
34 : head-clump ( seq -- array )
35 [ <head-clumps> ] [ [ like ] curry map ] bi ;
37 TUPLE: tail-clumps seq ;
38 C: <tail-clumps> tail-clumps
39 M: tail-clumps length seq>> length ;
40 M: tail-clumps nth-unsafe seq>> swap tail-slice ;
41 INSTANCE: tail-clumps immutable-sequence
43 : tail-clump ( seq -- array )
44 [ <tail-clumps> ] [ [ like ] curry map ] bi ;
46 : clump-as ( seq n exemplar -- array )
47 [ <clumps> ] dip [ like ] curry map ;
49 : group-as ( seq n exemplar -- array )
50 [ <groups> ] dip [ like ] curry map ;
54 : (group-by) ( groups elt key -- groups )
55 pick [ t ] [ last first dupd = not ] if-empty [
56 swap 1vector 2array over push
58 drop over last last push
63 : group-by ( seq quot: ( elt -- key ) -- groups )
64 '[ dup _ call( x -- y ) (group-by) ] V{ } clone swap reduce ;
66 :: <n-groups> ( seq n -- groups )
68 len n /mod :> ( step rem! )
71 dup step + rem zero? [ 1 + rem 1 - rem! ] unless
72 [ seq <slice> ] keep swap
76 : n-group ( seq n -- groups )
77 [ <n-groups> ] map-like ;