src/overload/tuples.lisp

   1
   2 (in-package :lineal.overload)
   3
   4 (defstruct tuple
   5   (dim 0 :type (integer 0 *))
   6   (elems nil :type list))
   7
   8 ;;; Make sure tuple /u/ is represented by a cons.
   9 ;;; Optionally do dimension checking.
  10 (defmacro ensure-tuple-is-cons
  11   (u &optional dim str)
  12   (if dim
  13     `(if (consp ,u)
  14        (unless (= (length ,u) ,dim)
  15          (throw 'over-ex ,str))
  16        (if (= (tuple-dim ,u) ,dim)
  17          (setq ,u (tuple-elems ,u))
  18          (throw 'over-ex ,str)))
  19     `(unless (consp ,u)
  20        (setq ,u (tuple-elems ,u)))))
  21
  22 (defun over-dot-prod (u v)
  23   (declare (type (or tuple cons) u)
  24            (type (or tuple cons) v))
  25   (dot-prod
  26     (if (consp u) u (tuple-elems u))
  27     (if (consp v) v (tuple-elems v))))
  28
  29 (defun over-cross-prod (u v)
  30   (declare (type (or tuple cons) u)
  31            (type (or tuple cons) v))
  32   (ensure-tuple-is-cons
  33     u 3 "cross products require 3-D vectors")
  34   (ensure-tuple-is-cons
  35     v 3 "cross products require 3-D vectors")
  36   (make-tuple :dim 3 :elems (tuple-cross3 u v)))
  37
  38 ;;; Projection of /u/ onto /v/.
  39 (defun over-proj (u v)
  40   (declare (type (or tuple cons) u)
  41            (type (or tuple cons) v))
  42   (let ((tdim
  43           (if (consp u) (length u)
  44             (prog1 (tuple-dim u)
  45               (setq u (tuple-elems u))))))
  46     (ensure-tuple-is-cons
  47       v tdim "proj requires vectors of same dimension")
  48     (make-tuple :dim tdim
  49                 :elems (tuple-proj u v))))
  50
  51 ;;; Orthogonal component of the
  52 ;;; projection of /u/ onto /v/.
  53 (defun over-orth (u v)
  54   (declare (type (or tuple cons) u)
  55            (type (or tuple cons) v))
  56   (let ((tdim
  57           (if (consp u) (length u)
  58             (prog1 (tuple-dim u)
  59               (setq u (tuple-elems u))))))
  60     (ensure-tuple-is-cons
  61       v tdim "orth requires vectors of same dimension")
  62     (make-tuple :dim tdim
  63                 :elems (tuple-orth u v))))
  64
  65 (defmethod add2n ((u tuple) (v tuple))
  66   (if (= (tuple-dim u) (tuple-dim v))
  67     (make-tuple
  68       :dim (tuple-dim u)
  69       :elems (tuple-addn (tuple-elems u) (tuple-elems v)))
  70     (throw 'over-ex "don't add vectors of different dimension")))
  71
  72 (defmethod subtr2n ((a tuple) (b tuple))
  73   (if (= (tuple-dim a) (tuple-dim b))
  74     (make-tuple
  75       :dim (tuple-dim a)
  76       :elemes (tuple-addn a b))
  77     (throw 'over-ex "don't subtract vectors of different dimension")))
  78
  79 (defmethod mult2n ((k number) (u tuple))
  80   (make-tuple :dim (tuple-dim u)
  81               :elems (scalar-tuple-multn
  82                        k (tuple-elems u))))
  83 (defmethod mult2n ((u tuple) (k number))
  84   (make-tuple :dim (tuple-dim u)
  85               :elems (scalar-tuple-multn
  86                        k (tuple-elems u))))
  87
  88 (defmethod divis2n ((u tuple) (k number))
  89   (make-tuple :dim (tuple-dim u)
  90               :elems (tuple-scalar-divisn
  91                        (tuple-elems u) k)))
  92
  93