diff --git a/basis/grouping/grouping-docs.factor b/basis/grouping/grouping-docs.factor index b9af98d1f8..4136209f4b 100644 --- a/basis/grouping/grouping-docs.factor +++ b/basis/grouping/grouping-docs.factor @@ -22,7 +22,12 @@ ARTICLE: "grouping" "Groups and clumps" { "With clumps, collecting the first element of each subsequence but the last one, together with the last subseqence, yields the original sequence:" { $unchecked-example "dup n clumps unclip-last [ [ first ] map ] dip append sequence= ." "t" } } -} ; +} +"A combinator built using clumps:" +{ $subsection monotonic? } +"Testing how elements are related:" +{ $subsection all-eq? } +{ $subsection all-equal? } ; ABOUT: "grouping" @@ -123,3 +128,23 @@ HELP: { } related-words { } related-words + +HELP: monotonic? +{ $values { "seq" sequence } { "quot" { $quotation "( elt elt -- ? )" } } { "?" "a boolean" } } +{ $description "Applies the relation to successive pairs of elements in the sequence, testing for a truth value. The relation should be a transitive relation, such as a total order or an equality relation." } +{ $examples + "Testing if a sequence is non-decreasing:" + { $example "USING: math prettyprint sequences ;" "{ 1 1 2 } [ <= ] monotonic? ." "t" } + "Testing if a sequence is decreasing:" + { $example "USING: math prettyprint sequences ;" "{ 9 8 6 7 } [ < ] monotonic? ." "f" } +} ; + +HELP: all-equal? +{ $values { "seq" sequence } { "?" "a boolean" } } +{ $description "Tests if all elements in the sequence are equal. Yields true with an empty sequence." } ; + +HELP: all-eq? +{ $values { "seq" sequence } { "?" "a boolean" } } +{ $description "Tests if all elements in the sequence are the same identical object. Yields true with an empty sequence." } ; + +{ monotonic? all-eq? all-equal? } related-words diff --git a/basis/grouping/grouping.factor b/basis/grouping/grouping.factor index b4d4c08d42..14210d6070 100644 --- a/basis/grouping/grouping.factor +++ b/basis/grouping/grouping.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2005, 2008 Slava Pestov. +! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel math math.order strings arrays vectors sequences sequences.private accessors ; @@ -87,3 +87,17 @@ INSTANCE: sliced-clumps slice-chunking : group ( seq n -- array ) { } like ; : clump ( seq n -- array ) { } like ; + +: monotonic? ( seq quot -- ? ) + over length 2 < [ 2drop t ] [ + over length 2 = [ + [ first2-unsafe ] dip call + ] [ + [ 2 ] dip + [ first2-unsafe ] prepose all? + ] if + ] if ; inline + +: all-equal? ( seq -- ? ) [ = ] monotonic? ; + +: all-eq? ( seq -- ? ) [ eq? ] monotonic? ; \ No newline at end of file diff --git a/core/io/io-docs.factor b/core/io/io-docs.factor index 95bccd8b18..a77031fdd0 100644 --- a/core/io/io-docs.factor +++ b/core/io/io-docs.factor @@ -168,7 +168,7 @@ HELP: lines HELP: each-line { $values { "quot" { $quotation "( str -- )" } } } -{ $description "Calls the quotatin with successive lines of text, until the current " { $link input-stream } " is exhausted." } ; +{ $description "Calls the quotation with successive lines of text, until the current " { $link input-stream } " is exhausted." } ; HELP: contents { $values { "stream" "an input stream" } { "str" string } } diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index 651c8e8a14..0b9dbcdfa7 100644 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -415,18 +415,6 @@ HELP: filter-here { $description "Applies the quotation to each element in turn, and removes elements for which the quotation outputs a false value." } { $side-effects "seq" } ; -HELP: monotonic? -{ $values { "seq" sequence } { "quot" { $quotation "( elt elt -- ? )" } } { "?" "a boolean" } } -{ $description "Applies the relation to successive pairs of elements in the sequence, testing for a truth value. The relation should be a transitive relation, such as a total order or an equality relation." } -{ $examples - "Testing if a sequence is non-decreasing:" - { $example "USING: math prettyprint sequences ;" "{ 1 1 2 } [ <= ] monotonic? ." "t" } - "Testing if a sequence is decreasing:" - { $example "USING: math prettyprint sequences ;" "{ 9 8 6 7 } [ < ] monotonic? ." "f" } -} ; - -{ monotonic? all-eq? all-equal? } related-words - HELP: interleave { $values { "seq" sequence } { "between" "a quotation" } { "quot" { $quotation "( elt -- )" } } } { $description "Applies " { $snippet "quot" } " to each element in turn, also invoking " { $snippet "between" } " in-between each pair of elements." } @@ -565,14 +553,6 @@ HELP: pop { $side-effects "seq" } { $errors "Throws an error if the sequence is empty." } ; -HELP: all-equal? -{ $values { "seq" sequence } { "?" "a boolean" } } -{ $description "Tests if all elements in the sequence are equal. Yields true with an empty sequence." } ; - -HELP: all-eq? -{ $values { "seq" sequence } { "?" "a boolean" } } -{ $description "Tests if all elements in the sequence are the same identical object. Yields true with an empty sequence." } ; - HELP: mismatch { $values { "seq1" sequence } { "seq2" sequence } { "i" "an index" } } { $description "Compares pairs of elements up to the minimum of the sequences' lengths, outputting the first index where the two sequences have non-equal elements, or " { $link f } " if all tested elements were equal." } ; @@ -1443,8 +1423,6 @@ ARTICLE: "sequences-combinators" "Sequence combinators" "Testing if a sequence contains elements satisfying a predicate:" { $subsection contains? } { $subsection all? } -"Testing how elements are related:" -{ $subsection monotonic? } { $subsection "sequence-2combinators" } { $subsection "sequence-3combinators" } ; @@ -1473,10 +1451,7 @@ ARTICLE: "sequences-tests" "Testing sequences" "Testing if a sequence contains a subsequence:" { $subsection head? } { $subsection tail? } -{ $subsection subseq? } -"Testing how elements are related:" -{ $subsection all-eq? } -{ $subsection all-equal? } ; +{ $subsection subseq? } ; ARTICLE: "sequences-search" "Searching sequences" "Finding the index of an element:" diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 5a92dcaf2d..061da05669 100644 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -386,10 +386,6 @@ PRIVATE> [ 2drop f f ] if ; inline -: (monotonic) ( seq quot -- ? ) - [ 2dup nth-unsafe rot 1+ rot nth-unsafe ] - prepose curry ; inline - : (interleave) ( n elt between quot -- ) roll 0 = [ nip ] [ swapd 2slip ] if call ; inline @@ -479,9 +475,6 @@ PRIVATE> : partition ( seq quot -- trueseq falseseq ) over [ 2pusher [ each ] 2dip ] dip tuck [ like ] 2bi@ ; inline -: monotonic? ( seq quot -- ? ) - [ [ length 1- ] keep ] dip (monotonic) all? ; inline - : interleave ( seq between quot -- ) [ (interleave) ] 2curry [ [ length ] keep ] dip 2each ; inline @@ -671,10 +664,6 @@ PRIVATE> : pop ( seq -- elt ) [ length 1- ] [ [ nth ] [ shorten ] 2bi ] bi ; -: all-equal? ( seq -- ? ) [ = ] monotonic? ; - -: all-eq? ( seq -- ? ) [ eq? ] monotonic? ; - : exchange ( m n seq -- ) pick over bounds-check 2drop 2dup bounds-check 2drop exchange-unsafe ; @@ -696,9 +685,7 @@ PRIVATE> 0 [ length + ] reduce ; : concat ( seq -- newseq ) - [ - { } - ] [ + [ { } ] [ [ sum-lengths ] keep [ first new-resizable ] keep [ [ over push-all ] each ] keep