Loading alexandria-2/arrays.lisp 0 → 100644 +43 −0 Original line number Diff line number Diff line (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))) alexandria-2/package.lisp +6 −0 Original line number Diff line number Diff line Loading @@ -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* Loading alexandria-2/tests.lisp +52 −0 Original line number Diff line number Diff line Loading @@ -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))) Loading alexandria.asd +1 −0 Original line number Diff line number Diff line Loading @@ -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"))))) Loading Loading
alexandria-2/arrays.lisp 0 → 100644 +43 −0 Original line number Diff line number Diff line (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)))
alexandria-2/package.lisp +6 −0 Original line number Diff line number Diff line Loading @@ -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* Loading
alexandria-2/tests.lisp +52 −0 Original line number Diff line number Diff line Loading @@ -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))) Loading
alexandria.asd +1 −0 Original line number Diff line number Diff line Loading @@ -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"))))) Loading