diff options
Diffstat (limited to 'arraymap.scm')
-rw-r--r-- | arraymap.scm | 72 |
1 files changed, 35 insertions, 37 deletions
diff --git a/arraymap.scm b/arraymap.scm index 747962e..2c88eb8 100644 --- a/arraymap.scm +++ b/arraymap.scm @@ -1,5 +1,5 @@ ;;;; "arraymap.scm", applicative routines for arrays in Scheme. -;;; Copyright (c) 1993, 2003 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 @@ -30,21 +30,20 @@ ;;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)) - (do ((i (cadar rshape) (+ -1 i)) - (is (cons (cadar rshape) inds) + (define (ramap rdims inds) + (if (null? (cdr rdims)) + (do ((i (+ -1 (car rdims)) (+ -1 i)) + (is (cons (+ -1 (car rdims)) inds) (cons (+ -1 i) inds))) - ((< i (caar rshape))) + ((negative? i)) (apply array-set! ra0 (apply proc (map (lambda (ra) (apply array-ref ra is)) ras)) is)) - (let ((crshape (cdr rshape)) - (ll (caar rshape))) - (do ((i (cadar rshape) (+ -1 i))) - ((< i ll)) - (ramap crshape (cons i inds)))))) - (ramap (reverse (array-shape ra0)) '())) + (let ((crdims (cdr rdims))) + (do ((i (+ -1 (car rdims)) (+ -1 i))) + ((negative? i)) + (ramap crdims (cons i inds)))))) + (ramap (reverse (array-dimensions ra0)) '())) ;;@args prototype proc array1 array2 @dots{} ;;@var{array2}, @dots{} must have the same number of dimensions as @@ -55,7 +54,7 @@ ;;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))) + (define nra (apply make-array prototype (array-dimensions ra1))) (apply array-map! nra proc ra1 ras) nra) @@ -63,20 +62,20 @@ ;;@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)) + (define (rafe rdims inds) + (if (null? (cdr rdims)) (let ((sdni (reverse (cons #f inds)))) (define lastpair (last-pair sdni)) - (do ((i (caar rshape) (+ 1 i))) - ((> i (cadar rshape))) + (do ((i 0 (+ 1 i))) + ((> i (+ -1 (car rdims)))) (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))) + (let ((crdims (cdr rdims)) + (ll (+ -1 (car rdims)))) + (do ((i 0 (+ 1 i))) ((> i ll)) - (rafe crshape (cons i inds)))))) - (rafe (array-shape (car ras)) '())) + (rafe crdims (cons i inds)))))) + (rafe (array-dimensions (car ras)) '())) ;;@args array ;;Returns an array of lists of indexes for @var{array} such that, if @@ -84,7 +83,7 @@ ;;(equal? @var{li} (apply array-ref (array-indexes @var{array}) ;;@var{li})). (define (array-indexes ra) - (let ((ra0 (apply create-array '#() (array-shape ra)))) + (let ((ra0 (apply make-array '#() (array-dimensions ra)))) (array-index-map! ra0 list) ra0)) @@ -96,7 +95,7 @@ ;;One can implement @var{array-indexes} as ;;@example ;;(define (array-indexes array) -;; (let ((ra (apply create-array '#() (array-shape array)))) +;; (let ((ra (apply make-array '#() (array-dimensions array)))) ;; (array-index-map! ra (lambda x x)) ;; ra)) ;;@end example @@ -108,26 +107,25 @@ ;; v)) ;;@end example (define (array-index-map! ra fun) - (define (ramap rshape inds) - (if (null? (cdr rshape)) - (do ((i (cadar rshape) (+ -1 i)) - (is (cons (cadar rshape) inds) + (define (ramap rdims inds) + (if (null? (cdr rdims)) + (do ((i (+ -1 (car rdims)) (+ -1 i)) + (is (cons (+ -1 (car rdims)) inds) (cons (+ -1 i) inds))) - ((< i (caar rshape))) + ((negative? i)) (apply array-set! ra (apply fun is) is)) - (let ((crshape (cdr rshape)) - (ll (caar rshape))) - (do ((i (cadar rshape) (+ -1 i))) - ((< i ll)) - (ramap crshape (cons i inds)))))) + (let ((crdims (cdr rdims))) + (do ((i (+ -1 (car rdims)) (+ -1 i))) + ((negative? i)) + (ramap crdims (cons i inds)))))) (if (zero? (array-rank ra)) (array-set! ra (fun)) - (ramap (reverse (array-shape ra)) '()))) + (ramap (reverse (array-dimensions ra)) '()))) -;;@args source destination +;;@args destination source ;;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) +(define (array:copy! dest source) (array-map! dest identity source)) |