From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 25 Aug 2022 14:10:48 +0000 (-0400)
Subject: sequenece.extras: add occurrence-count like ⊒ in bqn
X-Git-Tag: 0.99~595
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=107c1562f47731616e4b30cd42a52d1688caf236

sequenece.extras: add occurrence-count like ⊒ in bqn
---

diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor
index d3ca984448..e61844900f 100644
--- a/extra/sequences/extras/extras-tests.factor
+++ b/extra/sequences/extras/extras-tests.factor
@@ -251,6 +251,27 @@ strings tools.test ;
 { { } } [ { } [ + ] 0accumulate ] unit-test
 { { 100 101 103 107 } } [ { 100 1 2 4 } [ + ] 0accumulate ] unit-test
 
+{
+    H{ { t 6 } { f 5 } }
+    { 0 0 1 1 2 3 4 2 3 4 5 }
+} [
+    { 2 7 1 8 1 7 1 8 2 8 4 } [ even? ] occurrence-count-by
+] unit-test
+
+{
+    H{ { 8 3 } { 1 3 } { 2 2 } { 4 1 } { 7 2 } }
+    { 0 0 0 0 1 1 2 1 1 2 0 }
+} [
+    { 2 7 1 8 1 7 1 8 2 8 4 } occurrence-count
+] unit-test
+
+{
+    H{ { 8 3 } { 1 3 } { 2 2 } { 4 1 } { 7 2 } }
+    { 0 0 0 0 1 1 2 1 1 2 0 }
+} [
+    { 2 7 1 8 1 7 1 8 2 8 4 } [ ] occurrence-count-by
+] unit-test
+
 { { 0 1 2 3 } } [ 8 <iota> [ 4 < ] take-while >array ] unit-test
 { { } } [ { 15 16 } [ 4 < ] take-while >array ] unit-test
 { { 0 1 2 } } [ 3 <iota> [ 4 < ] take-while >array ] unit-test
diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor
index 30bbaf65b3..a780659c46 100644
--- a/extra/sequences/extras/extras.factor
+++ b/extra/sequences/extras/extras.factor
@@ -292,6 +292,12 @@ PRIVATE>
 : 0accumulate ( ... seq quot: ( ... prev elt -- ... next ) -- ... final newseq )
     over 0accumulate-as ; inline
 
+: occurrence-count-by ( seq quot: ( elt -- elt' ) -- hash seq )
+    '[ nip @ over inc-at* ] H{ } clone -rot 0accumulate ; inline
+
+: occurrence-count ( seq -- hash seq )
+    [ ] occurrence-count-by ; inline
+
 : 0reduce ( seq quot: ( prev elt -- next ) -- result )
     [ 0 ] dip reduce ; inline