1. Robert Smith
  2. qtility

Source

qtility / array.lisp

;;; 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)))))