src/overload/tuples.lisp

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