diff --git a/basis/splitting/monotonic/monotonic-tests.factor b/basis/splitting/monotonic/monotonic-tests.factor index 7bf9a38e8a..2b44f42394 100644 --- a/basis/splitting/monotonic/monotonic-tests.factor +++ b/basis/splitting/monotonic/monotonic-tests.factor @@ -15,6 +15,8 @@ USING: tools.test math arrays kernel sequences ; [ { { 1 } } ] [ { 1 } [ = ] slice monotonic-slice [ >array ] map ] unit-test +[ { 1 } [ = ] slice monotonic-slice ] must-infer + [ t ] [ { 1 1 1 2 2 3 3 4 } [ = ] slice monotonic-slice [ slice? ] all? ] unit-test diff --git a/basis/splitting/monotonic/monotonic.factor b/basis/splitting/monotonic/monotonic.factor index e39bba25ab..2e2ac74e30 100644 --- a/basis/splitting/monotonic/monotonic.factor +++ b/basis/splitting/monotonic/monotonic.factor @@ -24,13 +24,15 @@ PRIVATE> 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 + [ + dupd '[ + [ length ] [ ] [ 1 over change-circular-start ] tri + [ @ not [ , ] [ drop ] if ] 3each + ] { } make + dup empty? [ over length 1- prefix ] when -1 prefix 2 clump + swap + ] dip + '[ first2 [ 1+ ] bi@ _ _ boa ] map ; inline PRIVATE> @@ -39,7 +41,7 @@ PRIVATE> { 0 [ 2drop ] } { 1 [ nip [ 0 1 rot ] dip boa 1array ] } [ drop (monotonic-slice) ] - } case ; + } case ; inline TUPLE: downward-slice < slice ; TUPLE: stable-slice < slice ; diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index f3a12d9209..957b33198e 100644 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -338,6 +338,10 @@ HELP: 2each { $values { "seq1" sequence } { "seq2" sequence } { "quot" { $quotation "( elt1 elt2 -- )" } } } { $description "Applies the quotation to pairs of elements from " { $snippet "seq1" } " and " { $snippet "seq2" } "." } ; +HELP: 3each +{ $values { "seq1" sequence } { "seq2" sequence } { "seq3" sequence } { "quot" { $quotation "( elt1 elt2 elt3 -- )" } } } +{ $description "Applies the quotation to triples of elements from " { $snippet "seq1" } ", " { $snippet "seq2" } " and " { $snippet "seq3" } "." } ; + HELP: 2reduce { $values { "seq1" sequence } { "seq2" sequence } @@ -350,10 +354,18 @@ HELP: 2map { $values { "seq1" sequence } { "seq2" sequence } { "quot" { $quotation "( elt1 elt2 -- new )" } } { "newseq" "a new sequence" } } { $description "Applies the quotation to each pair of elements in turn, yielding new elements which are collected into a new sequence having the same class as " { $snippet "seq1" } "." } ; +HELP: 3map +{ $values { "seq1" sequence } { "seq2" sequence } { "seq3" sequence } { "quot" { $quotation "( elt1 elt2 elt3 -- new )" } } { "newseq" "a new sequence" } } +{ $description "Applies the quotation to each triple of elements in turn, yielding new elements which are collected into a new sequence having the same class as " { $snippet "seq1" } "." } ; + HELP: 2map-as { $values { "seq1" sequence } { "seq2" sequence } { "quot" { $quotation "( elt1 elt2 -- new )" } } { "exemplar" sequence } { "newseq" "a new sequence" } } { $description "Applies the quotation to each pair of elements in turn, yielding new elements which are collected into a new sequence having the same class as " { $snippet "exemplar" } "." } ; +HELP: 3map-as +{ $values { "seq1" sequence } { "seq2" sequence } { "seq3" sequence } { "quot" { $quotation "( elt1 elt2 elt3 -- new )" } } { "exemplar" sequence } { "newseq" "a new sequence" } } +{ $description "Applies the quotation to each triple of elements in turn, yielding new elements which are collected into a new sequence having the same class as " { $snippet "exemplar" } "." } ; + HELP: 2all? { $values { "seq1" sequence } { "seq2" sequence } { "quot" { $quotation "( elt1 elt2 -- ? )" } } { "?" "a boolean" } } { $description "Tests the predicate pairwise against elements of " { $snippet "seq1" } " and " { $snippet "seq2" } "." } ; @@ -1433,16 +1445,23 @@ ARTICLE: "sequences-combinators" "Sequence combinators" { $subsection all? } "Testing how elements are related:" { $subsection monotonic? } -{ $subsection "sequence-2combinators" } ; +{ $subsection "sequence-2combinators" } +{ $subsection "sequence-3combinators" } ; ARTICLE: "sequence-2combinators" "Pair-wise sequence combinators" -"There is a set of combinators which traverse two sequences pairwise. If one sequence is shorter than the other, than only the prefix having the length of the minimum of the two is examined." +"There is a set of combinators which traverse two sequences pairwise. If one sequence is shorter than the other, then only the prefix having the length of the minimum of the two is examined." { $subsection 2each } { $subsection 2reduce } { $subsection 2map } { $subsection 2map-as } { $subsection 2all? } ; +ARTICLE: "sequence-3combinators" "Triple-wise sequence combinators" +"There is a set of combinators which traverse three sequences triple-wise. If one sequence is shorter than the others, then only the prefix having the length of the minimum of the three is examined." +{ $subsection 3each } +{ $subsection 3map } +{ $subsection 3map-as } ; + ARTICLE: "sequences-tests" "Testing sequences" "Testing for an empty sequence:" { $subsection empty? } diff --git a/core/sorting/sorting-docs.factor b/core/sorting/sorting-docs.factor index 6ea1485425..290ca1470c 100644 --- a/core/sorting/sorting-docs.factor +++ b/core/sorting/sorting-docs.factor @@ -20,7 +20,8 @@ ABOUT: "sequences-sorting" HELP: sort { $values { "seq" "a sequence" } { "quot" { $quotation "( obj1 obj2 -- <=> )" } } { "sortedseq" "a new sorted sequence" } } -{ $description "Sorts the elements into a new array." } ; +{ $description "Sorts the elements into a new array using a stable sort." } +{ $notes "The algorithm used is the merge sort." } ; HELP: sort-keys { $values { "seq" "an alist" } { "sortedseq" "a new sorted sequence" } }