src/math/tuples.lisp

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