From: admin <admin@vouivredigital.com>
Date: Wed, 1 Nov 2023 10:40:06 +0000 (+0900)
Subject: Add utilities useful for working with arrays
X-Git-Tag: v0.2.0~24
X-Git-Url: https://git.vouivredigital.com/?a=commitdiff_plain;h=4b9b5adc16823fc8e9bfce0cf86af1b8dacf0abc;p=vouivre.git

Add utilities useful for working with arrays
---

diff --git a/misc.scm b/misc.scm
index aee2fed..42037a3 100644
--- a/misc.scm
+++ b/misc.scm
@@ -1,6 +1,15 @@
 (define-module (vouivre misc)
+  #:use-module (ice-9 arrays)
+  #:use-module (srfi srfi-1)
   #:export
-  (if-let))
+  (array-map
+   array-map-indexed
+   for-indices-in-range
+   if-let
+   ifn
+   list-zeros
+   map-indexed
+   produce-array))
 
 (define-syntax if-let
   (syntax-rules ()
@@ -10,3 +19,53 @@
     [(_ (x test) consequent)
      (let ([x test])
        (if x consequent))]))
+
+(define-syntax ifn
+  (syntax-rules ()
+    [(_ test alternate consequent)
+     (if test consequent alternate)]
+    [(_ test alternate)
+     (if (not test) alternate)]))
+
+(define (list-zeros n)
+  (list-tabulate n (lambda _ 0)))
+
+(define (map-indexed f . lists)
+  "Like `map' but the last argument of `f' is passed the corresponding index."
+  (apply map f (append lists (list (list-tabulate (length (car lists))
+						  identity)))))
+
+(define (for-indices-in-range f starts ends)
+  (define (for-indices-in-range% f indices starts ends)
+    (if (null? starts)
+      (apply f (reverse indices))
+      (do ((i (car starts) (1+ i)))
+        ((= i (car ends)))
+        (for-indices-in-range%
+          f
+          (cons i indices)
+          (cdr starts)
+          (cdr ends)))))
+  (for-indices-in-range% f '() starts ends))
+
+;;;; array utilities
+
+(define (produce-array f . dims)
+  (let ((a (apply make-array 0 dims)))
+    (array-index-map! a f)
+    a))
+
+(define (array-map proc array . more)
+  (let ((x (array-copy array)))
+    (apply array-map! x proc array more)
+    x))
+
+(define (array-map-indexed proc array)
+  (let ((x (array-copy array)))
+    (array-index-map!
+     x
+     (lambda indices
+       (apply proc
+	      (apply array-ref array indices)
+	      indices)))
+    x))