1 ! Copyright (C) 2008, 2009 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: make namespaces sequences kernel fry arrays compiler.utilities
4 math accessors circular grouping combinators sorting math.order ;
5 IN: splitting.monotonic
9 : ,, ( obj -- ) building get last push ;
10 : v, ( -- ) V{ } clone , ;
11 : ,v ( -- ) building get dup last empty? [ dup pop* ] when drop ;
13 : (monotonic-split) ( seq quot -- newseq )
15 [ dup unclip suffix ] dip
16 v, '[ over ,, @ [ v, ] unless ] 2each ,v
21 : monotonic-split ( seq quot -- newseq )
22 over empty? [ 2drop { } ] [ (monotonic-split) ] if ; inline
26 : (monotonic-slice) ( seq quot class -- slices )
29 [ length ] [ ] [ <circular> 1 over change-circular-start ] tri
30 [ @ not [ , ] [ drop ] if ] 3each
32 dup empty? [ over length 1- prefix ] when -1 prefix 2 clump
35 '[ first2 [ 1+ ] bi@ _ _ boa ] map ; inline
39 : monotonic-slice ( seq quot class -- slices )
42 { 1 [ nip [ 0 1 rot ] dip boa 1array ] }
43 [ drop (monotonic-slice) ]
46 TUPLE: downward-slice < slice ;
47 TUPLE: stable-slice < slice ;
48 TUPLE: upward-slice < slice ;
50 : downward-slices ( seq -- slices )
51 [ > ] downward-slice monotonic-slice [ length 1 > ] filter ;
53 : stable-slices ( seq -- slices )
54 [ = ] stable-slice monotonic-slice [ length 1 > ] filter ;
56 : upward-slices ( seq -- slices )
57 [ < ] upward-slice monotonic-slice [ length 1 > ] filter ;
59 : trends ( seq -- slices )
62 { 1 [ [ 0 1 ] dip stable-slice boa ] }
67 [ upward-slices ] tri 3append [ [ from>> ] compare ] sort