diff options
author | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:36 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:36 -0800 |
commit | 5bea21e81ed516440e34e480f2c33ca41aa8c597 (patch) | |
tree | 653ace1b8fe0a9916d861d35ff8f611b46c80d37 /subarray.scm | |
parent | 237c6e380aebdcbc70bd1c9ecf7d3f6effca2752 (diff) | |
download | slib-5bea21e81ed516440e34e480f2c33ca41aa8c597.tar.gz slib-5bea21e81ed516440e34e480f2c33ca41aa8c597.zip |
Import Upstream version 3a4upstream/3a4
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 |