From 428a1ae5818b2b5a91f8d1b7f22f24f812f5d8c7 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 21 Feb 2022 12:16:39 -0600
Subject: [PATCH] sequences.extras: Add a map-with-previous to let map see the
 previous iter's value

---
 extra/sequences/extras/extras-tests.factor |  8 +++++++
 extra/sequences/extras/extras.factor       | 28 +++++++++++++++++++++-
 2 files changed, 35 insertions(+), 1 deletion(-)

diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor
index b86e2739e3..8c3335060c 100644
--- a/extra/sequences/extras/extras-tests.factor
+++ b/extra/sequences/extras/extras-tests.factor
@@ -286,3 +286,11 @@ tools.test vectors vocabs ;
 { { 1 3 } } [ 1 4 2 10 <iota> <step-slice> >array ] unit-test
 { { 1 3 } } [ 1 5 2 10 <iota> <step-slice> >array ] unit-test
 { { 1 3 5 } } [ 1 6 2 10 <iota> <step-slice> >array ] unit-test
+
+{ { 2 3 5 } } [
+    [ swap [ * ] [ 100 + ] if* ] map-with-previous
+] unit-test
+
+{ { } } [
+    [ nip ] map-with-previous
+] unit-test
diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor
index 6a3fbc449b..9cd86797b8 100644
--- a/extra/sequences/extras/extras.factor
+++ b/extra/sequences/extras/extras.factor
@@ -1,5 +1,5 @@
 USING: accessors arrays assocs combinators generalizations
-grouping growable kernel math math.order ranges sequences
+grouping growable heaps kernel math math.order ranges sequences
 sequences.private shuffle sorting splitting vectors ;
 IN: sequences.extras
 
@@ -242,6 +242,32 @@ PRIVATE>
 : map-harvest ( ... seq quot: ( ... elt -- ... newelt ) -- ... newseq )
     [ empty? not ] map-filter ; inline
 
+: (each-integer-with-previous) ( ... prev i n quot: ( ... i -- ... ) -- ... )
+    2over < [
+        [ nip call ] 4keep nipdd
+        [ 1 + ] 2dip (each-integer-with-previous)
+    ] [
+        4drop
+    ] if ; inline recursive
+
+: each-integer-with-previous ( ... n quot: ( ... i -- ... ) -- ... )
+    [ f 0 ] 2dip (each-integer-with-previous) ; inline
+
+: (collect-with-previous) ( quot into -- quot' )
+    [ [ keep ] dip [ set-nth-unsafe ] keepdd ] 2curry ; inline
+
+: collect-with-previous ( n quot into --  )
+    (collect-with-previous) each-integer-with-previous ; inline
+
+: map-integers-with ( ... len quot: ( ... prev i -- ... elt ) exemplar -- ... newseq )
+    overd [ [ collect-with-previous ] keep ] new-like ; inline
+
+: map-with-previous-as ( ... seq quot: ( ... elt prev/f -- ... newelt ) exemplar -- ... newseq )
+    [ (1each) ] dip map-integers-with ; inline
+
+: map-with-previous ( ... seq quot: ( ... elt prev/f -- ... newelt ) -- ... newseq )
+    over map-with-previous-as ; inline
+
 <PRIVATE
 
 : (setup-each-from) ( i seq -- n quot )
-- 
2.34.1