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