From 96856b184a507886db2c5c20323983ae125a6bdb Mon Sep 17 00:00:00 2001
From: Colin Woodbury <colin@fosskers.ca>
Date: Mon, 19 Dec 2022 09:39:37 +0900
Subject: [PATCH 1/4] srfi-171: add twindow and various reducers

This adds a number of reduction primitives often seen in other languages
to Guile's SRFI-171 extensions.

Most critical may be `rfold`, which could be called the fundamental
reducer, as it's likely that all other reducers could be defined in
terms of it (though not all are). While `tfold` already exists in
Guile's SRFI-171 extension as a transducer, folding is in essence a
reduction. Also without a primative like `rlast` (also introduced here),
the results of `tfold` are difficult to consume. This is avoided by
providing `rfold` directly as a generalised means to collapse an entire
transduction down into a single value (i.e. the whole point of
reducers). `rfold` is also useful for the creation of ad-hoc reducers,
as any 2-arg function can be passed to it to fold the stream of values.

`rfirst`, `rlast`, and `rfind` are common idioms and so have been added.

The equivalent of `rmax` and `rmin` are easy to write manually via
`rfold`, but they have been provided here as a convenience in the same
spirit as `rcons`.

`rfor-each` also cannot be forgotten as a classic adaptation of its
SRFI-1 cousin.

Also added is `twindow`, handy for analysing groups of adjacent items.
---
 module/srfi/srfi-171/gnu.scm | 87 +++++++++++++++++++++++++++++++++++-
 1 file changed, 85 insertions(+), 2 deletions(-)

diff --git a/module/srfi/srfi-171/gnu.scm b/module/srfi/srfi-171/gnu.scm
index 45a4e19af..c41925e8a 100644
--- a/module/srfi/srfi-171/gnu.scm
+++ b/module/srfi/srfi-171/gnu.scm
@@ -15,10 +15,17 @@
 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (srfi srfi-171 gnu)
+  #:use-module (ice-9 q)
   #:use-module (srfi srfi-171)
   #:use-module (srfi srfi-171 meta)
-  #:export (tbatch tfold))
-
+  #:export (tbatch
+            tfold
+            twindow
+            rfind
+            rfirst rlast
+            rfold
+            rfor-each
+            rmax rmin))
 
 (define tbatch
   (case-lambda
@@ -63,3 +70,79 @@
          (if (reduced? state)
              (reduced (reducer (unreduce state)))
              (r result state)))))))
+
+(define (twindow n)
+  "Yield @var{n}-length windows of overlapping values.  This is different from
+@code{tsegment} which yields non-overlapping windows. If there were
+fewer items in the input than @var{n}, then this yields nothing."
+  (when (not (and (integer? n) (positive? n)))
+        (error "argument to twindow must be a positive integer"))
+  (lambda (reducer)
+    (let ((i 0)
+          (q (make-q)))
+      (case-lambda
+        (() (reducer))
+        ((result) (reducer result))
+        ((result input)
+         (enq! q input)
+         (set! i (1+ i))
+         (cond ((< i n) result)
+               ((= i n) (reducer result (list-copy (car q))))
+               (else (deq! q)
+                     (reducer result (list-copy (car q))))))))))
+
+(define rfor-each
+  (case-lambda
+    "Run through every item in a transduction for their side effects but throw away
+all results."
+    (() *unspecified*)
+    ((acc) *unspecified*)
+    ((acc input) *unspecified*)))
+
+(define (rfirst seed)
+  "Yield the first value of the transduction, or the @var{seed} value if there is none."
+  (case-lambda
+    (() seed)
+    ((acc) acc)
+    ((_ input) (reduced input))))
+
+(define (rlast seed)
+  "Yield the final value of the transduction, or the @var{seed} value if there is none."
+  (case-lambda
+    (() seed)
+    ((acc) acc)
+    ((_ input) input)))
+
+(define (rfold f seed)
+  "The fundamental reducer. @code{rfold} creates an ad-hoc reducer based on
+a given 2-argument function. A @var{seed} is also required as the
+initial accumulator value, which also becomes the return value in case
+there was no input left in the transduction.
+
+Functions like @code{+} and @code{*} are automatically valid reducers,
+because they yield sane values even when given 0 or 1 arguments. Other
+functions like @code{max} cannot be used as-is as reducers since they
+require at least 2 arguments. For functions like this, @code{rfold} is
+appropriate."
+  (case-lambda
+    (() seed)
+    ((acc) acc)
+    ((acc input) (f acc input))))
+
+(define (rmax seed)
+  "Yield the maximum value of the transduction, or the @var{seed} value if
+there is none."
+  (rfold max seed))
+
+(define (rmin seed)
+  "Yield the minimum value of the transduction, or the @var{seed} value if
+there is none."
+  (rfold min seed))
+
+(define (rfind pred?)
+  "Find the first element in the transduction that satisfies a given predicate.
+Yields #f if no such element was found."
+  (case-lambda
+    (() #f)
+    ((acc) acc)
+    ((acc input) (if (pred? input) (reduced input) #f))))
-- 
2.39.0