From ffeaf448a7dc527b9c38c9a3eb24770a389e861e Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Thu, 3 May 2012 11:31:38 -0700 Subject: [PATCH] sequences.extras: adding 2map-sum and 2count. --- extra/sequences/extras/extras-tests.factor | 3 +++ extra/sequences/extras/extras.factor | 6 ++++++ 2 files changed, 9 insertions(+) diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor index 1b58c180b7..dfee932f38 100644 --- a/extra/sequences/extras/extras-tests.factor +++ b/extra/sequences/extras/extras-tests.factor @@ -67,3 +67,6 @@ IN: sequences.extras.tests { V{ 0 4 16 36 64 } } [ 10 iota [ even? ] [ sq ] filter-map ] unit-test { { 2 6 10 14 18 } } [ 10 iota [ odd? ] [ 2 * ] { } filter-map-as ] unit-test + +{ 8 } [ 3 iota dup [ 1 + * ] 2map-sum ] unit-test +{ 4 } [ "hello" "jello" [ = ] 2count ] unit-test diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor index db08601045..8f20fcfc67 100644 --- a/extra/sequences/extras/extras.factor +++ b/extra/sequences/extras/extras.factor @@ -171,3 +171,9 @@ PRIVATE> : filter-map ( ... seq filter-quot: ( ... elt -- ... ? ) map-quot: ( ... elt -- ... newelt ) -- ... newseq ) pick filter-map-as ; inline + +: 2map-sum ( ... seq1 seq2 quot: ( ... elt1 elt2 -- ... n ) -- ... n ) + [ 0 ] 3dip [ dip + ] curry [ rot ] prepose 2each ; inline + +: 2count ( ... seq1 seq2 quot: ( ... elt1 elt2 -- ... ? ) -- ... n ) + [ 1 0 ? ] compose 2map-sum ; inline