sequences.merged: fix for input sequences of different lengths

diff --git a/basis/sequences/merged/merged-docs.factor b/basis/sequences/merged/merged-docs.factor
index da0d340126fd61e67638564048e5fc40258a9885..9b98cd1ed816e96a1e26494aa3df8d910beec535 100644 (file)
--- a/basis/sequences/merged/merged-docs.factor
+++ b/basis/sequences/merged/merged-docs.factor
@@ -20,7 +20,7 @@ HELP: merged
 
 HELP: <merged> ( 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 13a46f0b722009979fe4a386b05ab6abb97afb3e..1360bd8de1658d8e26dca1dcea54c101c99ba385 100644 (file)
--- 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 d64da6efe6ce6f5b1fd25ac982aff5e07dd4b2b3..0bc49976451e16e0f422492b41351c2e780f0c10 100644 (file)
--- 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> merged
 : <3merged> ( seq1 seq2 seq3 -- merged ) 3array <merged> ;
 
 : merge ( seqs -- seq )
-    dup <merged> swap first like ;
+    [ <merged> ] 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 ;