diff options
Diffstat (limited to 'sort.scm')
| -rw-r--r-- | sort.scm | 25 |
1 files changed, 13 insertions, 12 deletions
@@ -19,13 +19,14 @@ (define (sorted? seq less?) (cond ((null? seq) #t) ((array? seq) - (let ((shape (array-shape seq))) - (or (<= (- (cadar shape) (caar shape)) 0) - (do ((i (+ 1 (caar shape)) (+ i 1))) - ((or (= i (cadar shape)) + (let ((dims (array-dimensions seq))) + (define dimax (+ -1 (car dims))) + (or (<= dimax 0) + (do ((i 1 (+ i 1))) + ((or (= i dimax) (less? (array-ref seq i) (array-ref seq (- i 1)))) - (= i (cadar shape))))))) + (= i dimax)))))) (else (let loop ((last (car seq)) (next (cdr seq))) (or (null? next) @@ -117,10 +118,10 @@ (else '()))) (cond ((array? seq) - (let ((shape (array-shape seq)) + (let ((dims (array-dimensions seq)) (vec seq)) (set! seq (rank-1-array->list seq)) - (do ((p (step (+ 1 (cadar shape))) (cdr p)) + (do ((p (step (car dims)) (cdr p)) (i 0 (+ i 1))) ((null? p) vec) (array-set! vec (car p) i)))) @@ -128,10 +129,10 @@ (step (length seq))))) (define (rank-1-array->list array) - (define shape (array-shape array)) - (do ((idx (cadar shape) (+ -1 idx)) + (define dimensions (array-dimensions array)) + (do ((idx (+ -1 (car dimensions)) (+ -1 idx)) (lst '() (cons (array-ref array idx) lst))) - ((< idx (caar shape)) lst))) + ((< idx 0) lst))) ;;; (sort sequence less?) ;;; sorts a array, string, or list non-destructively. It does this @@ -146,8 +147,8 @@ ((string? seq) (list->string (sort:sort! (string->list seq) less?))) ((array? seq) - (let ((shape (array-shape seq))) - (define newra (apply create-array seq shape)) + (let ((dimensions (array-dimensions seq))) + (define newra (apply make-array seq dimensions)) (do ((sorted (sort:sort! (rank-1-array->list seq) less?) (cdr sorted)) (i 0 (+ i 1))) |