# qtility / array.lisp

 ``` 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58``` ```;;; array.lisp ;;; Copyright (c) 2011 Robert Smith (in-package #:qtility) (defun copy-array (array) "Make a copy of ARRAY." (let ((dims (array-dimensions array))) (adjust-array (make-array dims :element-type (array-element-type array) :displaced-to array) dims))) (defun rerank-array (dimensions array) "Reshape ARRAY to have dimensions specified by DIMENSIONS. This function makes a copy of ARRAY." (let ((copy (copy-array array))) (make-array dimensions :displaced-to copy))) (defun vector-range (a b &key (step 1)) "Compute the equivalent of (COERCE (RANGE A B :STEP STEP) 'VECTOR)." (assert (< a b)) (let* ((len (- b a)) (vec (make-array len :element-type 'integer :initial-element 0))) (loop :for i :below len :for vi :from a :below b :by step :do (setf (svref vec i) (funcall key vi)) :finally (return vec)))) (defun vector-slice (v indexes) "Compute the slice of a vector V at indexes INDEXES." (let ((result (make-array (length indexes)))) (loop :for n :from 0 :for i :in indexes :do (setf (aref result n) (aref v i)) :finally (return result)))) (defun vector-associative-reduce (vector associative-function) "Reduce VECTOR with ASSOCIATIVE-FUNCTION, using a divide-and-conquer method." (labels ((reduce-aux (lower upper) (declare (fixnum lower upper)) (case (- upper lower) ((0) (svref vector lower)) ((1) (funcall associative-function (svref vector lower) (svref vector upper))) (otherwise (let ((mid (floor (+ lower upper) 2))) (funcall associative-function (reduce-aux lower mid) (reduce-aux (1+ mid) upper))))))) (reduce-aux 0 (1- (length vector))))) ```