Skip to content
Snippets Groups Projects
Commit a1660438 authored by Philipp Marek's avatar Philipp Marek
Browse files

Merge branch 'indexing-helpers' into 'master'

Add functions relating to multidimensional array indexing conversions

See merge request alexandria/alexandria!20
parents 4e30ce7a e2718f69
No related branches found
No related tags found
No related merge requests found
(in-package :alexandria-2)
(defun dim-in-bounds-p (dimensions &rest subscripts)
"Mirrors cl:array-in-bounds-p, but takes dimensions (list of integers) as its
first argument instead of an array.
(array-in-bounds-p arr ...) == (dim-in-bounds-p (array-dimensions arr) ...)"
(and (= (length dimensions) (length subscripts))
(every (lambda (i d) (and (integerp i) (< -1 i d)))
subscripts dimensions)))
(defun row-major-index (dimensions &rest subscripts)
"Mirrors cl:array-row-major-index, but takes dimensions (list of integers)
as its first argument instead of an array.
Signals an error if lengths of dimensions and subscripts are not equal
(array-row-major-index arr ...) == (row-major-index (array-dimensions arr) ...)"
(unless (apply #'dim-in-bounds-p dimensions subscripts)
(error (format nil "Indices ~a invalid for dimensions ~a" subscripts dimensions)))
(loop with word-idx = 0
with dimprod = 1
for dim-size in (reverse dimensions)
for dim-idx in (reverse subscripts)
do
(incf word-idx (* dim-idx dimprod))
(setf dimprod (* dimprod dim-size))
finally (return word-idx)))
(defun rmajor-to-indices (dimensions index)
"The inverse function to row-major-index. Given a set of dimensions and a
row-major index, produce the list of indices <subscripts> such that
(row-major-index dimensions sucscripts) = index"
(when (null dimensions) (error "Dimensions must be non-null"))
(let ((size (reduce #'* dimensions)))
(unless (< -1 index size)
(error (format nil "Row-major index ~a invalid for array of total size ~a" index size))))
(labels ((rec (dimensions index word-sizes acc)
(if (null (cdr dimensions))
(reverse (cons index acc))
(multiple-value-bind (idx remainder) (floor index (car word-sizes))
(rec (cdr dimensions) remainder (cdr word-sizes) (cons idx acc))))))
(rec dimensions index
(cdr (reduce (lambda (x y) (cons (* x (car y)) y)) dimensions
:initial-value '(1) :from-end t))
nil)))
......@@ -5,7 +5,13 @@
#+sb-package-locks
(:lock t)
(:export
;; arrays
#:dim-in-bounds-p
#:row-major-index
#:rmajor-to-indices
;; lists
#:delete-from-plist*
;; control-flow
#:line-up-first
#:line-up-last
#:subseq*
......
......@@ -7,6 +7,58 @@
(in-package :alexandria2-tests)
;; Arrays Tests
(deftest dim-in-bounds-p.0
(dim-in-bounds-p '(2 2) 0 1 1)
nil)
(deftest dim-in-bounds-p.1
(dim-in-bounds-p '(2 2) 0 1)
t)
(deftest dim-in-bounds-p.2
(dim-in-bounds-p '(2 2) 0 2)
nil)
(deftest row-major-index.0
(let* ((dims '(4 3 2 1))
(test-arr (make-array dims))
(idcs '(0 0 0 0)))
(= 0 (apply #'row-major-index dims idcs) (apply #'array-row-major-index test-arr idcs)))
t)
(deftest row-major-index.1
(let* ((dims '(4 3 2 1))
(test-arr (make-array dims))
(idcs '(3 2 1 0)))
(= 23 (apply #'row-major-index dims idcs) (apply #'array-row-major-index test-arr idcs)))
t)
(deftest row-major-index.2
(let* ((dims '(4 3 2 1))
(test-arr (make-array dims))
(idcs '(2 1 0 0)))
(= 14 (apply #'row-major-index dims idcs) (apply #'array-row-major-index test-arr idcs)))
t)
(deftest row-major-index.3
(let* ((dims '(4 3 2 1))
(test-arr (make-array dims))
(idcs '(0 2 1 0)))
(= 5 (apply #'row-major-index dims idcs) (apply #'array-row-major-index test-arr idcs)))
t)
(deftest rmajor-to-indices.0
(loop for dims in '((70 30 4 2) (50 200 5 7) (5 4 300 2) (5 2 30 19))
with index = 173
with indices = '(4 0 3 1)
always (and (= index (apply #'row-major-index dims (rmajor-to-indices dims index)))
(equalp indices (rmajor-to-indices dims
(apply #'row-major-index dims indices)))))
t)
;; List Tests
(deftest delete-from-plist*.middle
(let ((input (list 'a 1 'b 2 'c 3 'd 4 'd 5)))
(multiple-value-list (delete-from-plist* input 'b 'c)))
......
......@@ -63,6 +63,7 @@ the following constraints:
(:module "alexandria-2"
:components ((:static-file "tests.lisp")
(:file "package")
(:file "arrays" :depends-on ("package"))
(:file "control-flow" :depends-on ("package"))
(:file "sequences" :depends-on ("package"))
(:file "lists" :depends-on ("package")))))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment