diff options
Diffstat (limited to 'subarray.scm')
| -rw-r--r-- | subarray.scm | 21 |
1 files changed, 15 insertions, 6 deletions
diff --git a/subarray.scm b/subarray.scm index 152ccbb..9f84583 100644 --- a/subarray.scm +++ b/subarray.scm @@ -52,6 +52,15 @@ ;;#2A((a b) (d e)) ;;> (subarray ra #f '(1 2)) ;;#2A((b c) (e f)) +;;> (subarray ra #f '(2 1)) +;;#2A((c b) (f e)) +;;@end example +;; +;;Arrays can be reflected (reversed) using @0: +;; +;;@example +;;> (subarray '#1A(a b c d e) '(4 0)) +;;#1A(e d c b a) ;;@end example (define (subarray array . selects) (apply make-shared-array array @@ -68,7 +77,10 @@ ((list? (car sels)) (loop (cdr sels) (cdr args) - (cons (+ (car args) (caar sels)) lst))) + (cons (if (< (cadar sels) (caar sels)) + (+ (- (caar sels) (car args))) + (+ (caar sels) (car args))) + lst))) (else (loop (cdr sels) (cdr args) (cons (car args) lst)))))) (let loop ((sels selects) @@ -88,15 +100,12 @@ ((list? (car sels)) (loop (cdr sels) (cdr dims) - (cons (list 0 (- (cadar sels) (caar sels))) ndims))) + (cons (list 0 (abs (- (cadar sels) (caar sels)))) + ndims))) (else (loop (cdr sels) (cdr dims) (cons (car sels) ndims))))))) ;;@body -;;Legacy alias for @r{subarray}. -(define subarray0 subarray) - -;;@body ;; ;;Returns a subarray sharing contents with @1 except for slices removed ;;from either side of each dimension. Each of the @2 is an exact |