diff --git a/basis/sequences/merged/merged-docs.factor b/basis/sequences/merged/merged-docs.factor index da0d340126..9b98cd1ed8 100644 --- a/basis/sequences/merged/merged-docs.factor +++ b/basis/sequences/merged/merged-docs.factor @@ -20,7 +20,7 @@ HELP: merged HELP: ( seqs -- merged ) { $values { "seqs" "a sequence of sequences to merge" } { "merged" "a virtual sequence" } } -{ $description "Creates an instance of the " { $link merged } " virtual sequence." } +{ $description "Creates an instance of the " { $link merged } " virtual sequence. The length of the created virtual sequences is the minimum length of the input sequences times the number of input sequences." } { $see-also <2merged> <3merged> merge } ; HELP: <2merged> ( seq1 seq2 -- merged ) diff --git a/basis/sequences/merged/merged-tests.factor b/basis/sequences/merged/merged-tests.factor index 13a46f0b72..1360bd8de1 100644 --- a/basis/sequences/merged/merged-tests.factor +++ b/basis/sequences/merged/merged-tests.factor @@ -15,3 +15,5 @@ IN: sequences.merged.tests [ 6 ] [ 5 { 1 2 3 } { 4 5 6 } <2merged> nth ] unit-test [ 4 ] [ 4 { 1 2 } { 3 4 } { 5 6 } 3merge nth ] unit-test + +[ "" ] [ "abcdefg" "" 2merge ] unit-test diff --git a/basis/sequences/merged/merged.factor b/basis/sequences/merged/merged.factor index d64da6efe6..0bc4997645 100644 --- a/basis/sequences/merged/merged.factor +++ b/basis/sequences/merged/merged.factor @@ -1,6 +1,7 @@ ! Copyright (C) 2008 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays kernel math sequences ; +USING: accessors arrays kernel math math.order sequences +sequences.private ; IN: sequences.merged TUPLE: merged seqs ; @@ -10,18 +11,19 @@ C: merged : <3merged> ( seq1 seq2 seq3 -- merged ) 3array ; : merge ( seqs -- seq ) - dup swap first like ; + [ ] keep first like ; : 2merge ( seq1 seq2 -- seq ) - dupd <2merged> swap like ; + [ <2merged> ] 2keep drop like ; : 3merge ( seq1 seq2 seq3 -- seq ) - pick [ <3merged> ] dip like ; + [ <3merged> ] 3keep 2drop like ; -M: merged length seqs>> [ length ] map sum ; +M: merged length + seqs>> [ [ length ] [ min ] map-reduce ] [ length ] bi * ; M: merged virtual@ ( n seq -- n' seq' ) - seqs>> [ length /mod ] [ nth ] bi ; + seqs>> [ length /mod ] [ nth-unsafe ] bi ; M: merged virtual-seq ( merged -- seq ) [ ] { } map-as ;