summaryrefslogtreecommitdiffstats
path: root/arraymap.scm
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:29 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:29 -0800
commit8466d8cfa486fb30d1755c4261b781135083787b (patch)
treec8c12c67246f543c3cc4f64d1c07e003cb1d45ae /arraymap.scm
parent87b82b5822ca54228cfa6df29be3ad9d4bc47d16 (diff)
downloadslib-8466d8cfa486fb30d1755c4261b781135083787b.tar.gz
slib-8466d8cfa486fb30d1755c4261b781135083787b.zip
Import Upstream version 3a1upstream/3a1
Diffstat (limited to 'arraymap.scm')
-rw-r--r--arraymap.scm83
1 files changed, 69 insertions, 14 deletions
diff --git a/arraymap.scm b/arraymap.scm
index 15e24da..747962e 100644
--- a/arraymap.scm
+++ b/arraymap.scm
@@ -1,5 +1,5 @@
;;;; "arraymap.scm", applicative routines for arrays in Scheme.
-;;; Copyright (c) 1993 Aubrey Jaffer
+;;; Copyright (c) 1993, 2003 Aubrey Jaffer
;
;Permission to copy this software, to modify it, to redistribute it,
;to distribute modified versions, and to use it for any purpose is
@@ -8,7 +8,7 @@
;1. Any copy made of this software must include this copyright notice
;in full.
;
-;2. I have made no warrantee or representation that the operation of
+;2. I have made no warranty or representation that the operation of
;this software will be error-free, and I am under no obligation to
;provide any services, by way of maintenance, update, or otherwise.
;
@@ -19,6 +19,16 @@
(require 'array)
+;;@code{(require 'array-for-each)}
+;;@ftindex array-for-each
+
+;;@args array0 proc array1 @dots{}
+;;@var{array1}, @dots{} must have the same number of dimensions as
+;;@var{array0} and have a range for each index which includes the range
+;;for the corresponding index in @var{array0}. @var{proc} is applied to
+;;each tuple of elements of @var{array1} @dots{} and the result is stored
+;;as the corresponding element in @var{array0}. The value returned is
+;;unspecified. The order of application is unspecified.
(define (array-map! ra0 proc . ras)
(define (ramap rshape inds)
(if (null? (cdr rshape))
@@ -27,8 +37,7 @@
(cons (+ -1 i) inds)))
((< i (caar rshape)))
(apply array-set! ra0
- (apply proc (map (lambda (ra) (apply array-ref ra is))
- ras))
+ (apply proc (map (lambda (ra) (apply array-ref ra is)) ras))
is))
(let ((crshape (cdr rshape))
(ll (caar rshape)))
@@ -37,14 +46,31 @@
(ramap crshape (cons i inds))))))
(ramap (reverse (array-shape ra0)) '()))
+;;@args prototype proc array1 array2 @dots{}
+;;@var{array2}, @dots{} must have the same number of dimensions as
+;;@var{array1} and have a range for each index which includes the
+;;range for the corresponding index in @var{array1}. @var{proc} is
+;;applied to each tuple of elements of @var{array1}, @var{array2},
+;;@dots{} and the result is stored as the corresponding element in a
+;;new array of type @var{prototype}. The new array is returned. The
+;;order of application is unspecified.
+(define (array-map prototype proc ra1 . ras)
+ (define nra (apply create-array prototype (array-shape ra1)))
+ (apply array-map! nra proc ra1 ras)
+ nra)
+
+;;@args proc array0 @dots{}
+;;@var{proc} is applied to each tuple of elements of @var{array0} @dots{}
+;;in row-major order. The value returned is unspecified.
(define (array-for-each proc . ras)
(define (rafe rshape inds)
(if (null? (cdr rshape))
- (do ((i (caar rshape) (+ 1 i)))
- ((> i (cadar rshape)))
- (apply proc
- (map (lambda (ra)
- (apply array-ref ra (reverse (cons i inds)))) ras)))
+ (let ((sdni (reverse (cons #f inds))))
+ (define lastpair (last-pair sdni))
+ (do ((i (caar rshape) (+ 1 i)))
+ ((> i (cadar rshape)))
+ (set-car! lastpair i)
+ (apply proc (map (lambda (ra) (apply array-ref ra sdni)) ras))))
(let ((crshape (cdr rshape))
(ll (cadar rshape)))
(do ((i (caar rshape) (+ 1 i)))
@@ -52,6 +78,35 @@
(rafe crshape (cons i inds))))))
(rafe (array-shape (car ras)) '()))
+;;@args array
+;;Returns an array of lists of indexes for @var{array} such that, if
+;;@var{li} is a list of indexes for which @var{array} is defined,
+;;(equal? @var{li} (apply array-ref (array-indexes @var{array})
+;;@var{li})).
+(define (array-indexes ra)
+ (let ((ra0 (apply create-array '#() (array-shape ra))))
+ (array-index-map! ra0 list)
+ ra0))
+
+;;@args array proc
+;;applies @var{proc} to the indices of each element of @var{array} in
+;;turn, storing the result in the corresponding element. The value
+;;returned and the order of application are unspecified.
+;;
+;;One can implement @var{array-indexes} as
+;;@example
+;;(define (array-indexes array)
+;; (let ((ra (apply create-array '#() (array-shape array))))
+;; (array-index-map! ra (lambda x x))
+;; ra))
+;;@end example
+;;Another example:
+;;@example
+;;(define (apl:index-generator n)
+;; (let ((v (make-vector n 1)))
+;; (array-index-map! v (lambda (i) i))
+;; v))
+;;@end example
(define (array-index-map! ra fun)
(define (ramap rshape inds)
(if (null? (cdr rshape))
@@ -69,10 +124,10 @@
(array-set! ra (fun))
(ramap (reverse (array-shape ra)) '())))
-(define (array-indexes ra)
- (let ((ra0 (apply make-array '() (array-shape ra))))
- (array-index-map! ra0 list)
- ra0))
-
+;;@args source destination
+;;Copies every element from vector or array @var{source} to the
+;;corresponding element of @var{destination}. @var{destination} must
+;;have the same rank as @var{source}, and be at least as large in each
+;;dimension. The order of copying is unspecified.
(define (array-copy! source dest)
(array-map! dest identity source))