From 327a4ba5afe90f4e70593f3192753931bb94581b Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 17 Jul 2015 10:26:29 -0700 Subject: [PATCH] splitting.monotonic: cleanup and simplify monotonic-split. --- .../splitting/monotonic/monotonic-docs.factor | 26 ++++---- .../monotonic/monotonic-tests.factor | 30 ++++----- basis/splitting/monotonic/monotonic.factor | 65 +++++++++---------- basis/wrap/words/words.factor | 2 +- 4 files changed, 55 insertions(+), 68 deletions(-) diff --git a/basis/splitting/monotonic/monotonic-docs.factor b/basis/splitting/monotonic/monotonic-docs.factor index 019fce5995..6af6294842 100644 --- a/basis/splitting/monotonic/monotonic-docs.factor +++ b/basis/splitting/monotonic/monotonic-docs.factor @@ -3,23 +3,19 @@ USING: help.markup help.syntax kernel quotations classes sequences ; IN: splitting.monotonic -HELP: monotonic-slice +HELP: monotonic-split-slice { $values - { "seq" sequence } { "quot" { $quotation ( obj1 obj2 -- ? ) } } { "slice-class" class } - { "slices" "a sequence of slices" } + { "seq" sequence } { "quot" { $quotation ( obj1 obj2 -- ? ) } } + { "pieces" "a sequence of slices" } } -{ $description "Monotonically splits a sequence into slices of the type " { $snippet "slice-class" } "." } +{ $description "Monotonically splits a sequence into slices." } { $examples { $example "USING: splitting.monotonic math prettyprint ;" - "{ 1 2 3 2 3 4 } [ < ] upward-slice monotonic-slice ." + "{ 1 2 3 2 3 4 } [ < ] monotonic-split-slice ." """{ - T{ upward-slice { to 3 } { seq { 1 2 3 2 3 4 } } } - T{ upward-slice - { from 3 } - { to 6 } - { seq { 1 2 3 2 3 4 } } - } + T{ slice { to 3 } { seq { 1 2 3 2 3 4 } } } + T{ slice { from 3 } { to 6 } { seq { 1 2 3 2 3 4 } } } }""" } } ; @@ -27,14 +23,14 @@ HELP: monotonic-slice HELP: monotonic-split { $values { "seq" sequence } { "quot" quotation } - { "newseq" "a sequence of sequences" } + { "pieces" "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." } +{ $description "Monotonically splits a sequence." } { $examples { $example "USING: splitting.monotonic math prettyprint ;" "{ 1 2 3 2 3 4 } [ < ] monotonic-split ." - "{ V{ 1 2 3 } V{ 2 3 4 } }" + "{ { 1 2 3 } { 2 3 4 } }" } } ; @@ -90,7 +86,7 @@ ARTICLE: "splitting.monotonic" "Splitting trending sequences" "Splitting into sequences:" { $subsections monotonic-split } "Splitting into slices:" -{ $subsections monotonic-slice } +{ $subsections monotonic-split-slice } "Trending:" { $subsections downward-slices diff --git a/basis/splitting/monotonic/monotonic-tests.factor b/basis/splitting/monotonic/monotonic-tests.factor index dbbd0a9040..0bc56ce7b2 100644 --- a/basis/splitting/monotonic/monotonic-tests.factor +++ b/basis/splitting/monotonic/monotonic-tests.factor @@ -2,33 +2,33 @@ IN: splitting.monotonic USING: tools.test math arrays kernel sequences ; { { } } [ { } [ < ] monotonic-split ] unit-test -{ { V{ 1 } } } [ { 1 } [ < ] monotonic-split ] unit-test -{ { V{ 1 2 } } } [ { 1 2 } [ < ] monotonic-split ] unit-test -{ { V{ 1 } V{ 2 } } } [ { 1 2 } [ > ] monotonic-split ] unit-test -{ { V{ 1 } V{ -1 5 } V{ 2 4 } } } +{ { { 1 } } } [ { 1 } [ < ] monotonic-split ] unit-test +{ { { 1 2 } } } [ { 1 2 } [ < ] monotonic-split ] unit-test +{ { { 1 } { 2 } } } [ { 1 2 } [ > ] monotonic-split ] unit-test +{ { { 1 } { -1 5 } { 2 4 } } } [ { 1 -1 5 2 4 } [ < ] monotonic-split ] unit-test -{ { V{ 1 1 1 1 } V{ 2 2 } V{ 3 } V{ 4 } V{ 5 } V{ 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 ] unit-test { { } } -[ "" [ = ] slice monotonic-slice ] unit-test +[ "" [ = ] monotonic-split-slice ] unit-test { t } -[ { 1 } [ = ] slice monotonic-slice [ slice? ] all? ] unit-test +[ { 1 } [ = ] monotonic-split-slice [ slice? ] all? ] unit-test { { { 1 } } } -[ { 1 } [ = ] slice monotonic-slice [ >array ] map ] unit-test +[ { 1 } [ = ] monotonic-split ] unit-test -[ { 1 } [ = ] slice monotonic-slice ] must-infer +[ { 1 } [ = ] monotonic-split-slice ] must-infer { t } -[ { 1 1 1 2 2 3 3 4 } [ = ] slice monotonic-slice [ slice? ] all? ] unit-test +[ { 1 1 1 2 2 3 3 4 } [ = ] monotonic-split-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 +[ { 1 1 1 2 2 3 3 4 } [ = ] monotonic-split ] unit-test { { { 3 3 } } } -[ { 3 3 } [ = ] slice monotonic-slice [ >array ] map ] unit-test +[ { 3 3 } [ = ] monotonic-split ] unit-test { { } } [ "" trends ] unit-test @@ -64,14 +64,12 @@ USING: tools.test math arrays kernel sequences ; { { { 2 2 } { 3 3 3 3 } { 4 } { 5 } } } [ { 2 2 3 3 3 3 4 5 } - [ [ odd? ] same? ] slice monotonic-slice - [ >array ] map + [ [ odd? ] same? ] monotonic-split ] unit-test { { { 1 1 1 } { 2 2 2 2 } { 3 3 } } } [ { 1 1 1 2 2 2 2 3 3 } - [ [ odd? ] same? ] slice monotonic-slice - [ >array ] map + [ [ odd? ] same? ] monotonic-split ] unit-test diff --git a/basis/splitting/monotonic/monotonic.factor b/basis/splitting/monotonic/monotonic.factor index 6e90b5638a..024a7e32fa 100644 --- a/basis/splitting/monotonic/monotonic.factor +++ b/basis/splitting/monotonic/monotonic.factor @@ -1,59 +1,52 @@ ! Copyright (C) 2008, 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays fry kernel locals make math namespaces -sequences sorting ; +USING: accessors arrays fry kernel locals math namespaces +sequences sequences.private sorting ; IN: splitting.monotonic accum + + 0 0 seq [ ] [ + [ 1 + ] 2dip [ + quot call [ + [ seq slice-quot call accum push ] keep dup + ] unless + ] keep + ] map-reduce drop + + n = [ drop ] [ n seq slice-quot call accum push ] if + + accum { } like ; inline + +: (monotonic-split) ( seq quot slice-quot -- pieces ) + pick length [ 3drop { } ] [ ((monotonic-split)) ] if-zero ; inline PRIVATE> -: monotonic-split ( seq quot: ( obj1 obj2 -- ? ) -- newseq ) - over empty? [ 2drop { } ] [ (monotonic-split) ] if ; inline +: monotonic-split ( seq quot: ( obj1 obj2 -- ? ) -- pieces ) + [ subseq-unsafe ] (monotonic-split) ; inline - len - [ - 0 , - - 0 seq [ ] [ - [ 1 + ] 2dip - [ quot call [ dup , ] unless ] keep - ] map-reduce 2drop - - len building get ?last = [ len , ] unless - - ] { } make dup rest-slice [ seq slice-class boa ] 2map ; inline - -PRIVATE> - -: monotonic-slice ( seq quot: ( obj1 obj2 -- ? ) slice-class -- slices ) - pick length dup 1 > [ - drop (monotonic-slice) - ] [ - zero? [ 3drop { } ] [ nip [ 0 1 ] 2dip boa 1array ] if - ] if ; inline +: monotonic-split-slice ( seq quot: ( obj1 obj2 -- ? ) -- pieces ) + [ ] (monotonic-split) ; inline TUPLE: downward-slice < slice ; TUPLE: stable-slice < slice ; TUPLE: upward-slice < slice ; : downward-slices ( seq -- slices ) - [ > ] downward-slice monotonic-slice [ length 1 > ] filter ; + [ > ] [ downward-slice boa ] (monotonic-split) + [ length 1 > ] filter ; : stable-slices ( seq -- slices ) - [ = ] stable-slice monotonic-slice [ length 1 > ] filter ; + [ = ] [ stable-slice boa ] (monotonic-split) + [ length 1 > ] filter ; : upward-slices ( seq -- slices ) - [ < ] upward-slice monotonic-slice [ length 1 > ] filter ; + [ < ] [ upward-slice boa ] (monotonic-split) + [ length 1 > ] filter ; : trends ( seq -- slices ) dup length dup 1 > [ diff --git a/basis/wrap/words/words.factor b/basis/wrap/words/words.factor index 2b47249ba9..72e22f9f0e 100644 --- a/basis/wrap/words/words.factor +++ b/basis/wrap/words/words.factor @@ -21,7 +21,7 @@ C: word ] if ; : split-words ( seq -- half-elements ) - [ [ break?>> ] same? ] monotonic-split ; + [ [ break?>> ] same? ] monotonic-split-slice ; : ?first-break ( seq -- newseq f/element ) dup first first break?>>