src/math/tuples.lisp

   1
   2 ;V Basic vector/tuple operations, V
   3 ;V they behave like the normal    V
   4 ;V lisp math functions.           V
   5
   6 (defun tuple-addn (&rest vecs)
   7   (apply #'mapcar #'+ vecs))
   8
   9 (defun tuple-n2addn (u v)
  10   (do ((u-rem u (cdr u-rem))
  11        (v-rem v (cdr v-rem)))
  12     ((or (not u-rem) (not v-rem)) u)
  13     (incf (car u-rem) (car v-rem))))
  14
  15 (defun tuple-subtrn (&rest vecs)
  16   (apply #'mapcar #'- vecs))
  17
  18 ;V Take 2 vectors and destructively V
  19 ;V modify /u/ to reflect its        V
  20 ;V difference with vector /v/       V
  21 (defun tuple-n2subtrn (u v)
  22   (do ((u-rem u (cdr u-rem))
  23        (v-rem v (cdr v-rem)))
  24     ((or (not u-rem) (not v-rem)) u)
  25     (decf (car u-rem) (car v-rem))))
  26
  27 (defun scalar-tuple-multn (k u)
  28   (mapcar (lambda (ui) (* k ui)) u))
  29
  30 (defun tuple-scalar-divisn (u k)
  31   "The vector /u/ divided by scalar /k/"
  32   (unless (= k 1)
  33     (mapcar (lambda (ui) (/ ui k)) u)))
  34
  35 ;V Exact same as above function but  V
  36 ;V destructively modifies vector /u/.V
  37 (defun tuple-scalar-ndivisn (u k)
  38   (if (= k 1) u
  39     (do ((tail u (cdr tail)))
  40       ((not tail) u)
  41       (rplaca tail (/ (car tail) k)))))
  42
  43 (defun tuple-magnitude (u)
  44   "Find the magnitude of a vector /u/"
  45   (let ((s 0))
  46     ;V Sum the squares of the vector's elements.V
  47     (mapc (lambda (ui) (incf s (expt ui 2))) u)
  48     (sqrt s)));-> Return the sum's square root.
  49
  50 ;V Euclidean inner product.V
  51 (defun dot-prod (a b)
  52   (loop :for x :in a
  53         :and y :in b
  54         :sum (* x y)))
  55
  56 ;V Quick cross product, all elems V
  57 ;V passed individually for speed. V
  58 (defun qcross3 (a b c d e f)
  59   (list
  60     (- (* b f) (* c e))
  61     (- (* c d) (* a f))
  62     (- (* a e) (* b d))))
  63 (defun tuple-cross3 (a b)
  64   (multiple-value-call
  65     #'qcross3 (values-list a)
  66     (values-list b)))
  67
  68 ;V Projection of u onto v.V
  69 (defun tuple-proj (u v)
  70   (declare (inline dot-prod))
  71   (scalar-tuple-multn
  72     (/ (dot-prod u v)
  73        (dot-prod v v))
  74     v))
  75
  76 ;V Orthojection - orthogonal component V
  77 ;V to the projection of u onto v.      V
  78 (defun tuple-orth (u v)
  79   (tuple-subtrn u (tuple-proj u v)))
  80