diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor index e33819e580..2ef0bfe15f 100644 --- a/extra/sequences/extras/extras-tests.factor +++ b/extra/sequences/extras/extras-tests.factor @@ -71,3 +71,5 @@ IN: sequences.extras.tests { 8 } [ 3 iota dup [ 1 + * ] 2map-sum ] unit-test { 4 } [ "hello" "jello" [ = ] 2count ] unit-test + +{ "ADEBFC" } [ { "ABC" "D" "EF" } round-robin ] unit-test diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor index b565894fc1..0759d8172f 100644 --- a/extra/sequences/extras/extras.factor +++ b/extra/sequences/extras/extras.factor @@ -183,3 +183,16 @@ PRIVATE> : 2count ( ... seq1 seq2 quot: ( ... elt1 elt2 -- ... ? ) -- ... n ) [ 1 0 ? ] compose 2map-sum ; inline + +:: round-robin-as ( seqs exemplar -- newseq ) + seqs length :> len + 0 0 seqs sum-lengths [ + f [ + drop dup len >= [ drop 1 + 0 ] when + 2dup seqs nth-unsafe ?nth + [ 1 + ] [ dup not ] bi* + ] loop + ] exemplar replicate-as 2nip ; + +: round-robin ( seqs -- newseq ) + [ { } ] [ dup first round-robin-as ] if-empty ;