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