1 ! Copyright (C) 2005, 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: kernel math math.order strings arrays vectors sequences
4 sequences.private accessors ;
9 TUPLE: chunking-seq { seq read-only } { n read-only } ;
11 : check-groups dup 0 <= [ "Invalid group count" throw ] when ; inline
13 : new-groups ( seq n class -- groups )
14 [ check-groups ] dip boa ; inline
16 GENERIC: group@ ( n groups -- from to seq )
18 M: chunking-seq set-nth group@ <slice> 0 swap copy ;
20 M: chunking-seq like drop { } like ;
22 INSTANCE: chunking-seq sequence
24 MIXIN: subseq-chunking
26 M: subseq-chunking nth group@ subseq ;
30 M: slice-chunking nth group@ <slice> ;
32 M: slice-chunking nth-unsafe group@ slice boa ;
34 TUPLE: abstract-groups < chunking-seq ;
36 M: abstract-groups length
37 [ seq>> length ] [ n>> ] bi [ + 1- ] keep /i ;
39 M: abstract-groups set-length
40 [ n>> * ] [ seq>> ] bi set-length ;
42 M: abstract-groups group@
43 [ n>> [ * dup ] keep + ] [ seq>> ] bi [ length min ] keep ;
45 TUPLE: abstract-clumps < chunking-seq ;
47 M: abstract-clumps length
48 [ seq>> length ] [ n>> ] bi - 1+ ;
50 M: abstract-clumps set-length
51 [ n>> + 1- ] [ seq>> ] bi set-length ;
53 M: abstract-clumps group@
54 [ n>> over + ] [ seq>> ] bi ;
58 TUPLE: groups < abstract-groups ;
60 : <groups> ( seq n -- groups )
61 groups new-groups ; inline
63 INSTANCE: groups subseq-chunking
65 TUPLE: sliced-groups < abstract-groups ;
67 : <sliced-groups> ( seq n -- groups )
68 sliced-groups new-groups ; inline
70 INSTANCE: sliced-groups slice-chunking
72 TUPLE: clumps < abstract-clumps ;
74 : <clumps> ( seq n -- clumps )
75 clumps new-groups ; inline
77 INSTANCE: clumps subseq-chunking
79 TUPLE: sliced-clumps < abstract-clumps ;
81 : <sliced-clumps> ( seq n -- clumps )
82 sliced-clumps new-groups ; inline
84 INSTANCE: sliced-clumps slice-chunking
86 : group ( seq n -- array ) <groups> { } like ;
88 : clump ( seq n -- array ) <clumps> { } like ;