add upward/stable/downward slices, monotonic-slice, trends and docs
parent
0a9677c0af
commit
b9f0d16026
|
@ -0,0 +1,109 @@
|
||||||
|
! Copyright (C) 2009 Doug Coleman.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: help.markup help.syntax kernel quotations classes sequences
|
||||||
|
multiline ;
|
||||||
|
IN: splitting.monotonic
|
||||||
|
|
||||||
|
HELP: monotonic-slice
|
||||||
|
{ $values
|
||||||
|
{ "seq" sequence } { "quot" quotation } { "class" class }
|
||||||
|
{ "slices" "a sequence of slices" }
|
||||||
|
}
|
||||||
|
{ $description "Monotonically splits a sequence into slices of the type " { $snippet "class" } "." }
|
||||||
|
{ $examples
|
||||||
|
{ $example
|
||||||
|
"USING: splitting.monotonic math prettyprint ;"
|
||||||
|
"{ 1 2 3 2 3 4 } [ < ] upward-slice monotonic-slice ."
|
||||||
|
<" {
|
||||||
|
T{ upward-slice
|
||||||
|
{ from 0 }
|
||||||
|
{ to 3 }
|
||||||
|
{ seq { 1 2 3 2 3 4 } }
|
||||||
|
}
|
||||||
|
T{ upward-slice
|
||||||
|
{ from 3 }
|
||||||
|
{ to 6 }
|
||||||
|
{ seq { 1 2 3 2 3 4 } }
|
||||||
|
}
|
||||||
|
}">
|
||||||
|
}
|
||||||
|
} ;
|
||||||
|
|
||||||
|
HELP: monotonic-split
|
||||||
|
{ $values
|
||||||
|
{ "seq" sequence } { "quot" quotation }
|
||||||
|
{ "newseq" "a sequence of sequences" }
|
||||||
|
}
|
||||||
|
{ $description "Compares pairs of elements in a sequence and collects elements into sequences while they satisfy the predicate. Once the predicate fails, a new sequence is started, and all sequences are returned in a single sequence." }
|
||||||
|
{ $examples
|
||||||
|
{ $example
|
||||||
|
"USING: splitting.monotonic math prettyprint ;"
|
||||||
|
"{ 1 2 3 2 3 4 } [ < ] monotonic-split ."
|
||||||
|
"{ V{ 1 2 3 } V{ 2 3 4 } }"
|
||||||
|
}
|
||||||
|
} ;
|
||||||
|
|
||||||
|
HELP: downward-slices
|
||||||
|
{ $values
|
||||||
|
{ "seq" sequence }
|
||||||
|
{ "slices" "a sequence of downward-slices" }
|
||||||
|
}
|
||||||
|
{ $description "Returns an array of monotonically decreasing slices of type " { $link downward-slice } ". Slices of one element are discarded." } ;
|
||||||
|
|
||||||
|
HELP: stable-slices
|
||||||
|
{ $values
|
||||||
|
{ "seq" sequence }
|
||||||
|
{ "slices" "a sequence of stable-slices" }
|
||||||
|
}
|
||||||
|
{ $description "Returns an array of monotonically decreasing slices of type " { $link downward-slice } ". Slices of one element are discarded." } ;
|
||||||
|
|
||||||
|
HELP: upward-slices
|
||||||
|
{ $values
|
||||||
|
{ "seq" sequence }
|
||||||
|
{ "slices" "a sequence of upward-slices" }
|
||||||
|
}
|
||||||
|
{ $description "Returns an array of monotonically increasing slices of type " { $link downward-slice } ". Slices of one element are discarded." } ;
|
||||||
|
|
||||||
|
HELP: trends
|
||||||
|
{ $values
|
||||||
|
{ "seq" sequence }
|
||||||
|
{ "slices" "a sequence of downward, stable, and upward slices" }
|
||||||
|
}
|
||||||
|
{ $description "Returns a sorted sequence of downward, stable, or upward slices. The endpoints of some slices may overlap with each other." }
|
||||||
|
{ $examples
|
||||||
|
{ $example
|
||||||
|
"USING: splitting.monotonic math prettyprint ;"
|
||||||
|
"{ 1 2 3 3 2 1 } trends ."
|
||||||
|
<" {
|
||||||
|
T{ upward-slice
|
||||||
|
{ from 0 }
|
||||||
|
{ to 3 }
|
||||||
|
{ seq { 1 2 3 3 2 1 } }
|
||||||
|
}
|
||||||
|
T{ stable-slice
|
||||||
|
{ from 2 }
|
||||||
|
{ to 4 }
|
||||||
|
{ seq { 1 2 3 3 2 1 } }
|
||||||
|
}
|
||||||
|
T{ downward-slice
|
||||||
|
{ from 3 }
|
||||||
|
{ to 6 }
|
||||||
|
{ seq { 1 2 3 3 2 1 } }
|
||||||
|
}
|
||||||
|
}">
|
||||||
|
}
|
||||||
|
} ;
|
||||||
|
|
||||||
|
ARTICLE: "splitting.monotonic" "Splitting trending sequences"
|
||||||
|
"The " { $vocab-link "splitting.monotonic" } " vocabulary splits sequences that are trending downwards, upwards, or stably." $nl
|
||||||
|
"Splitting into sequences:"
|
||||||
|
{ $subsection monotonic-split }
|
||||||
|
"Splitting into slices:"
|
||||||
|
{ $subsection monotonic-slice }
|
||||||
|
"Trending:"
|
||||||
|
{ $subsection downward-slices }
|
||||||
|
{ $subsection stable-slices }
|
||||||
|
{ $subsection upward-slices }
|
||||||
|
{ $subsection trends } ;
|
||||||
|
|
||||||
|
ABOUT: "splitting.monotonic"
|
|
@ -6,3 +6,48 @@ USING: tools.test math arrays kernel sequences ;
|
||||||
[ { { 1 1 1 1 } { 2 2 } { 3 } { 4 } { 5 } { 6 6 6 } } ]
|
[ { { 1 1 1 1 } { 2 2 } { 3 } { 4 } { 5 } { 6 6 6 } } ]
|
||||||
[ { 1 1 1 1 2 2 3 4 5 6 6 6 } [ = ] monotonic-split [ >array ] map ] unit-test
|
[ { 1 1 1 1 2 2 3 4 5 6 6 6 } [ = ] monotonic-split [ >array ] map ] unit-test
|
||||||
|
|
||||||
|
[ { } ]
|
||||||
|
[ { } [ = ] slice monotonic-slice ] unit-test
|
||||||
|
|
||||||
|
[ t ]
|
||||||
|
[ { 1 } [ = ] slice monotonic-slice [ slice? ] all? ] unit-test
|
||||||
|
|
||||||
|
[ { { 1 } } ]
|
||||||
|
[ { 1 } [ = ] slice monotonic-slice [ >array ] map ] unit-test
|
||||||
|
|
||||||
|
[ t ]
|
||||||
|
[ { 1 1 1 2 2 3 3 4 } [ = ] slice monotonic-slice [ slice? ] all? ] unit-test
|
||||||
|
|
||||||
|
[ { { 1 1 1 } { 2 2 } { 3 3 } { 4 } } ]
|
||||||
|
[ { 1 1 1 2 2 3 3 4 } [ = ] slice monotonic-slice [ >array ] map ] unit-test
|
||||||
|
|
||||||
|
[ { { 3 3 } } ]
|
||||||
|
[ { 3 3 } [ = ] slice monotonic-slice [ >array ] map ] unit-test
|
||||||
|
|
||||||
|
[
|
||||||
|
{
|
||||||
|
T{ upward-slice { from 0 } { to 3 } { seq { 1 2 3 2 1 } } }
|
||||||
|
T{ downward-slice { from 2 } { to 5 } { seq { 1 2 3 2 1 } } }
|
||||||
|
}
|
||||||
|
]
|
||||||
|
[ { 1 2 3 2 1 } trends ] unit-test
|
||||||
|
|
||||||
|
[
|
||||||
|
{
|
||||||
|
T{ upward-slice
|
||||||
|
{ from 0 }
|
||||||
|
{ to 3 }
|
||||||
|
{ seq { 1 2 3 3 2 1 } }
|
||||||
|
}
|
||||||
|
T{ stable-slice
|
||||||
|
{ from 2 }
|
||||||
|
{ to 4 }
|
||||||
|
{ seq { 1 2 3 3 2 1 } }
|
||||||
|
}
|
||||||
|
T{ downward-slice
|
||||||
|
{ from 3 }
|
||||||
|
{ to 6 }
|
||||||
|
{ seq { 1 2 3 3 2 1 } }
|
||||||
|
}
|
||||||
|
}
|
||||||
|
] [ { 1 2 3 3 2 1 } trends ] unit-test
|
||||||
|
|
|
@ -1,8 +1,11 @@
|
||||||
! Copyright (C) 2008 Doug Coleman.
|
! Copyright (C) 2008, 2009 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: make namespaces sequences kernel fry ;
|
USING: make namespaces sequences kernel fry arrays compiler.utilities
|
||||||
|
math accessors circular grouping combinators sorting math.order ;
|
||||||
IN: splitting.monotonic
|
IN: splitting.monotonic
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
: ,, ( obj -- ) building get peek push ;
|
: ,, ( obj -- ) building get peek push ;
|
||||||
: v, ( -- ) V{ } clone , ;
|
: v, ( -- ) V{ } clone , ;
|
||||||
: ,v ( -- ) building get dup peek empty? [ dup pop* ] when drop ;
|
: ,v ( -- ) building get dup peek empty? [ dup pop* ] when drop ;
|
||||||
|
@ -13,5 +16,52 @@ IN: splitting.monotonic
|
||||||
v, '[ over ,, @ [ v, ] unless ] 2each ,v
|
v, '[ over ,, @ [ v, ] unless ] 2each ,v
|
||||||
] { } make ; inline
|
] { } make ; inline
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
: monotonic-split ( seq quot -- newseq )
|
: monotonic-split ( seq quot -- newseq )
|
||||||
over empty? [ 2drop { } ] [ (monotonic-split) ] if ; inline
|
over empty? [ 2drop { } ] [ (monotonic-split) ] if ; inline
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
: (monotonic-slice) ( seq quot class -- slices )
|
||||||
|
-rot
|
||||||
|
dupd '[
|
||||||
|
[ length ] [ ] [ <circular> 1 over change-circular-start ] tri
|
||||||
|
[ @ not [ , ] [ drop ] if ] 3each
|
||||||
|
] { } make
|
||||||
|
dup empty? [ over length 1- prefix ] when -1 prefix 2 clump
|
||||||
|
[ first2 [ 1+ ] bi@ rot roll boa ] with with map ; inline
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
|
: monotonic-slice ( seq quot class -- slices )
|
||||||
|
pick length {
|
||||||
|
{ 0 [ 2drop ] }
|
||||||
|
{ 1 [ nip [ 0 1 rot ] dip boa 1array ] }
|
||||||
|
[ drop (monotonic-slice) ]
|
||||||
|
} case ;
|
||||||
|
|
||||||
|
TUPLE: downward-slice < slice ;
|
||||||
|
TUPLE: stable-slice < slice ;
|
||||||
|
TUPLE: upward-slice < slice ;
|
||||||
|
|
||||||
|
: downward-slices ( seq -- slices )
|
||||||
|
[ > ] downward-slice monotonic-slice [ length 1 > ] filter ;
|
||||||
|
|
||||||
|
: stable-slices ( seq -- slices )
|
||||||
|
[ = ] stable-slice monotonic-slice [ length 1 > ] filter ;
|
||||||
|
|
||||||
|
: upward-slices ( seq -- slices )
|
||||||
|
[ < ] upward-slice monotonic-slice [ length 1 > ] filter ;
|
||||||
|
|
||||||
|
: trends ( seq -- slices )
|
||||||
|
dup length {
|
||||||
|
{ 0 [ ] }
|
||||||
|
{ 1 [ [ 0 1 ] dip stable-slice boa ] }
|
||||||
|
[
|
||||||
|
drop
|
||||||
|
[ downward-slices ]
|
||||||
|
[ stable-slices ]
|
||||||
|
[ upward-slices ] tri 3append [ [ from>> ] compare ] sort
|
||||||
|
]
|
||||||
|
} case ;
|
||||||
|
|
Loading…
Reference in New Issue