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 (defmethod add2n ((u tuple) (v list))
  76   (add2n u (tuple-list v)))
  77
  78 (defmethod add2n ((u list) v)
  79   (add2n (tuple-list u) v))
  80
  81 ;;; u - v
  82 (defmethod subtr2n ((u tuple) (v tuple))
  83   (if (= (tuple-dim u) (tuple-dim v))
  84     (make-tuple
  85       :dim (tuple-dim u)
  86       :elems (tuple-subtrn (tuple-elems u) (tuple-elems v)))
  87     (throw 'over-ex "don't subtract vectors of different dimension")))
  88
  89 (defmethod subtr2n ((u tuple) (v list))
  90   (subtr2n u (tuple-list v)))
  91
  92 (defmethod subtr2n ((u list) v)
  93   (subtr2n (tuple-list u) v))
  94
  95 ;;; k * u
  96 (defmethod mult2n ((k number) (u tuple))
  97   (make-tuple :dim (tuple-dim u)
  98               :elems (scalar-tuple-multn
  99                        k (tuple-elems u))))
 100
 101 (defmethod mult2n ((k number) (u list))
 102   (make-tuple :dim (length u)
 103               :elems (scalar-tuple-multn k u)))
 104
 105 (defmethod mult2n ((u tuple) (k number))
 106   (make-tuple :dim (tuple-dim u)
 107               :elems (scalar-tuple-multn
 108                        k (tuple-elems u))))
 109
 110 (defmethod mult2n ((u list) (k number))
 111   (make-tuple :dim (length u)
 112               :elems (scalar-tuple-multn k u)))
 113
 114 ;;; u / k
 115 (defmethod divis2n ((u tuple) (k number))
 116   (make-tuple :dim (tuple-dim u)
 117               :elems (tuple-scalar-divisn
 118                        (tuple-elems u) k)))
 119
 120 (defmethod divis2n ((u list) (k number))
 121   (make-tuple :dim (length u)
 122               :elems (tuple-scalar-divisn u k)))
 123
 124