Skip to content
Snippets Groups Projects
Commit 35bdf54c authored by Anish Moorthy's avatar Anish Moorthy
Browse files

Implement dim-in-bounds-p and row-major-index

Similar functions are provided in CL, but they operate on *arrays* when all they
really need are the *dimensions*. This sometimes proves an annoyance, and I
thought alexandria was a good place to implement these.
parent c501bdd0
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)))
...@@ -4,7 +4,12 @@ ...@@ -4,7 +4,12 @@
#+sb-package-locks #+sb-package-locks
(:lock t) (:lock t)
(:export (:export
;; arrays
#:dim-in-bounds-p
#:row-major-index
;; lists
#:delete-from-plist* #:delete-from-plist*
;; control-flow
#:line-up-first #:line-up-first
#:line-up-last #:line-up-last
. #. (let (res) (do-external-symbols (sym :alexandria.1.0.0) (push sym res)) res) . #. (let (res) (do-external-symbols (sym :alexandria.1.0.0) (push sym res)) res)
......
...@@ -7,6 +7,51 @@ ...@@ -7,6 +7,51 @@
(in-package :alexandria2-tests) (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)
(deft)
;; List Tests
(deftest delete-from-plist*.middle (deftest delete-from-plist*.middle
(let ((input (list 'a 1 'b 2 'c 3 'd 4 'd 5))) (let ((input (list 'a 1 'b 2 'c 3 'd 4 'd 5)))
(multiple-value-list (delete-from-plist* input 'b 'c))) (multiple-value-list (delete-from-plist* input 'b 'c)))
......
...@@ -63,6 +63,7 @@ the following constraints: ...@@ -63,6 +63,7 @@ the following constraints:
(:module "alexandria-2" (:module "alexandria-2"
:components ((:static-file "tests.lisp") :components ((:static-file "tests.lisp")
(:file "package") (:file "package")
(:file "arrays" :depends-on ("package"))
(:file "control-flow" :depends-on ("package")) (:file "control-flow" :depends-on ("package"))
(:file "lists" :depends-on ("package"))))) (:file "lists" :depends-on ("package")))))
:in-order-to ((test-op (test-op "alexandria-tests")))) :in-order-to ((test-op (test-op "alexandria-tests"))))
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