sequences.extras: Add progress-index word like `𝕨 ⊒ 𝕩: Progressive Index Of` in bqn

diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor
index e61844900f74f3d71abe509c1b0b0cdd26e5d7b7..e09445309b2da21458987bc51e4112dd60e737d1 100644 (file)
--- a/extra/sequences/extras/extras-tests.factor
+++ b/extra/sequences/extras/extras-tests.factor
@@ -272,6 +272,18 @@ strings tools.test ;
     { 2 7 1 8 1 7 1 8 2 8 4 } [ ] occurrence-count-by
 ] unit-test
 
+{ { 1 2 0 3 3 3 3 3 3 3 3 3 3 3 3 3 } } [
+    "cab" "abcdefghijklmnop" progressive-index nip
+] unit-test
+
+{ { 0 1 2 3 3 } } [
+    "aaa" "aaaaa" progressive-index nip
+] unit-test
+
+{ { 0 3 1 4 2 5 5 5 5 5 } } [
+    "aaabb" "ababababab" progressive-index nip
+] 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 a780659c465b538c9dbbb621932bc9ed11342e7a..8463a9080763187174425779f9b68b454c5da05e 100644 (file)
--- a/extra/sequences/extras/extras.factor
+++ b/extra/sequences/extras/extras.factor
@@ -292,12 +292,28 @@ PRIVATE>
 : 0accumulate ( ... seq quot: ( ... prev elt -- ... next ) -- ... final newseq )
     over 0accumulate-as ; inline
 
-: occurrence-count-by ( seq quot: ( elt -- elt' ) -- hash seq )
+: 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 ( seq -- hash seq' )
     [ ] occurrence-count-by ; inline
 
+: nth-index ( n obj seq -- i )
+    [ = dup [ drop 1 - dup 0 < ] when ] with find drop nip ;
+
+: progressive-index-by-as ( seq1 seq2 quot exemplar -- hash seq' )
+    [
+        pick length '[
+            tuck [ @ over inc-at* ] 2dip swap nth-index _ or
+        ] [ H{ } clone ] 3dip with
+    ] dip map-as ; inline
+
+: progressive-index-by ( seq1 seq2 quot -- hash seq' )
+    { } progressive-index-by-as ; inline
+
+: progressive-index ( seq1 seq2 -- hash seq' )
+    [ ] progressive-index-by ; inline
+
 : 0reduce ( seq quot: ( prev elt -- next ) -- result )
     [ 0 ] dip reduce ; inline
 
@@ -925,6 +941,3 @@ M: virtual-zip-index nth-unsafe
     over [ seq>> nth-unsafe ] [ 2array ] bi* ; inline
 
 INSTANCE: virtual-zip-index immutable-sequence
-
-: nth-index ( n obj seq -- i )
-    [ = dup [ drop 1 - dup 0 < ] when ] with find drop nip ;