src/overload/matrices.lisp

   1
   2 (defstruct mtrix
   3   (dimdom 0 :type integer)
   4   (dimcodom 0 :type integer)
   5   (elems nil :type list))
   6
   7 (defun over-trace (a)
   8   (unless (= (mtrix-dimdom a) (mtrix-dimcodom a))
   9     (throw 'over-ex
  10            "Can only get the trace of a square matrix."))
  11   (loop :for i :from 0
  12         :for row :in (mtrix-elems a)
  13         :sum (elt row i)))
  14
  15 (defun make-mtrix-like (a elems)
  16   (make-mtrix
  17     :dimdom (mtrix-dimdom a)
  18     :dimcodom (mtrix-dimcodom a)
  19     :elems elems))
  20
  21 (defmethod over-transpose ((u tuple))
  22   (make-mtrix
  23     :dimdom (tuple-dim u)
  24     :dimcodom 1
  25     :elems (list (tuple-elems u))))
  26
  27 ; Return the transpose of a given matrix.V
  28 (defmethod over-transpose ((a mtrix))
  29   (make-mtrix
  30     :dimdom (mtrix-dimcodom a)
  31     :dimcodom (mtrix-dimdom a)
  32     :elems (mtrix-transpose (mtrix-elems a))))
  33
  34 (defmethod add2n ((a mtrix) (b mtrix))
  35   (if (and (= (mtrix-dimdom a) (mtrix-dimdom b))
  36            (= (mtrix-dimcodom a) (mtrix-dimcodom b)))
  37     (make-mtrix-like
  38       a (mtrix-addn (mtrix-elems a)
  39                     (mtrix-elems b)))))
  40
  41 (defmethod subtr2n ((a mtrix) (b mtrix))
  42   (if (and (= (mtrix-dimdom a) (mtrix-dimdom b))
  43            (= (mtrix-dimcodom a) (mtrix-dimcodom b)))
  44     (make-mtrix-like
  45       a (mtrix-subtrn (mtrix-elems a)
  46                       (mtrix-elems b)))))
  47
  48 (defmethod mult2n ((a number) (b mtrix))
  49   (make-mtrix-like
  50     b (scalar-mtrix-multn a (mtrix-elems b))))
  51
  52 (defmethod mult2n ((a mtrix) (b number))
  53   (make-mtrix-like
  54     a (scalar-mtrix-multn b (mtrix-elems a))))
  55
  56 (defmethod mult2n ((a mtrix) (b tuple))
  57   (if (= (mtrix-dimdom a) (tuple-dim b))
  58     (make-tuple
  59       :dim (mtrix-dimcodom a) :elems
  60       (mtrix-coltuple-multn
  61         (mtrix-elems a) (tuple-elems b)))
  62     (throw 'over-ex "Bad dimensions for matrix-vector multiplication.")))
  63
  64 (defmethod mult2n ((a tuple) (b mtrix))
  65   (if (= (tuple-dim a) (mtrix-dimcodom b))
  66     (make-tuple
  67       :dim (mtrix-dimdom b) :elems
  68       (car (mtrix-mult2n
  69              (list (tuple-elems a)) (mtrix-elems b))))
  70     (throw 'over-ex "Bad dimensions for vector-matrix multiplication.")))
  71
  72 (defmethod mult2n ((a mtrix) (b mtrix))
  73   (if (= (mtrix-dimdom a) (mtrix-dimcodom b))
  74     (make-mtrix
  75       :dimdom (mtrix-dimdom b)
  76       :dimcodom (mtrix-dimcodom a) :elems
  77       (mtrix-mult2n (mtrix-elems a) (mtrix-elems b)))
  78     (throw 'over-ex "Mismatched dimensions for matrix multiplication.")))
  79
  80 (defmethod divis2n ((a mtrix) (b number))
  81   (make-mtrix-like
  82     a (scalar-mtrix-multn
  83         (/ b) (mtrix-elems a))))
  84