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