steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

sequences.merged: fix for input sequences of different lengths

db4
Philipp Brüschweiler 2009-11-06 23:05:55 +01:00
parent 71c4da5558
commit c5c0e274cb
3 changed files with 11 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/sequences/merged/merged-docs.factor
View File

@ -20,7 +20,7 @@ HELP: merged
HELP: <merged> ( seqs -- merged ) HELP: <merged> ( seqs -- merged )
{ $values { "seqs" "a sequence of sequences to merge" } { "merged" "a virtual sequence" } } { $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 } ; { $see-also <2merged> <3merged> merge } ;
HELP: <2merged> ( seq1 seq2 -- merged ) HELP: <2merged> ( seq1 seq2 -- merged )

2
basis/sequences/merged/merged-tests.factor
View File

@ -15,3 +15,5 @@ IN: sequences.merged.tests
[ 6 ] [ 5 { 1 2 3 } { 4 5 6 } <2merged> nth ] unit-test [ 6 ] [ 5 { 1 2 3 } { 4 5 6 } <2merged> nth ] unit-test
[ 4 ] [ 4 { 1 2 } { 3 4 } { 5 6 } 3merge nth ] unit-test [ 4 ] [ 4 { 1 2 } { 3 4 } { 5 6 } 3merge nth ] unit-test
[ "" ] [ "abcdefg" "" 2merge ] unit-test

14
basis/sequences/merged/merged.factor
View File

@ -1,6 +1,7 @@
! Copyright (C) 2008 Alex Chapman ! Copyright (C) 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license. ! 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 IN: sequences.merged
TUPLE: merged seqs ; TUPLE: merged seqs ;
@ -10,18 +11,19 @@ C: <merged> merged
: <3merged> ( seq1 seq2 seq3 -- merged ) 3array <merged> ; : <3merged> ( seq1 seq2 seq3 -- merged ) 3array <merged> ;
: merge ( seqs -- seq ) : merge ( seqs -- seq )
dup <merged> swap first like ; [ <merged> ] keep first like ;
: 2merge ( seq1 seq2 -- seq ) : 2merge ( seq1 seq2 -- seq )
dupd <2merged> swap like ; [ <2merged> ] 2keep drop like ;
: 3merge ( seq1 seq2 seq3 -- seq ) : 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' ) 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 ; M: merged virtual-seq ( merged -- seq ) [ ] { } map-as ;