diff options
Diffstat (limited to 'arraymap.scm')
| -rw-r--r-- | arraymap.scm | 83 |
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)) |