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 make-mtrix-like (a elems)
   8   (make-mtrix
   9     :dimdom (mtrix-dimdom a)
  10     :dimcodom (mtrix-dimcodom a)
  11     :elems elems))
  12
  13 (defmethod over-transpose ((u tuple))
  14   (make-mtrix
  15     :dimdom (tuple-dim u)
  16     :dimcodom 1
  17     :elems (list (tuple-elems u))))
  18
  19 ; Return the transpose of a given matrix.V
  20 (defmethod over-transpose ((a mtrix))
  21   (make-mtrix
  22     :dimdom (mtrix-dimcodom a)
  23     :dimcodom (mtrix-dimdom a)
  24     :elems (mtrix-transpose (mtrix-elems a))))
  25
  26 (defmethod add2n ((a mtrix) (b mtrix))
  27   (if (and (= (mtrix-dimdom a) (mtrix-dimdom b))
  28            (= (mtrix-dimcodom a) (mtrix-dimcodom b)))
  29     (make-mtrix-like
  30       a (mtrix-addn (mtrix-elems a)
  31                     (mtrix-elems b)))))
  32
  33 (defmethod subtr2n ((a mtrix) (b mtrix))
  34   (if (and (= (mtrix-dimdom a) (mtrix-dimdom b))
  35            (= (mtrix-dimcodom a) (mtrix-dimcodom b)))
  36     (make-mtrix-like
  37       a (mtrix-subtrn (mtrix-elems a)
  38                       (mtrix-elems b)))))
  39
  40 (defmethod mult2n ((a number) (b mtrix))
  41   (make-mtrix-like
  42     b (scalar-mtrix-multn a (mtrix-elems b))))
  43
  44 (defmethod mult2n ((a mtrix) (b number))
  45   (make-mtrix-like
  46     a (scalar-mtrix-multn b (mtrix-elems a))))
  47
  48 (defmethod mult2n ((a mtrix) (b tuple))
  49   (if (= (mtrix-dimdom a) (tuple-dim b))
  50     (make-tuple
  51       :dim (mtrix-dimcodom a) :elems
  52       (mtrix-coltuple-multn
  53         (mtrix-elems a) (tuple-elems b)))
  54     (throw 'over-ex "Bad dimensions for matrix-vector multiplication.")))
  55
  56 (defmethod mult2n ((a tuple) (b mtrix))
  57   (if (= (tuple-dim a) (mtrix-dimcodom b))
  58     (make-tuple
  59       :dim (mtrix-dimdom b) :elems
  60       (car (mtrix-mult2n
  61              (list (tuple-elems a)) (mtrix-elems b))))
  62     (throw 'over-ex "Bad dimensions for vector-matrix multiplication.")))
  63
  64 (defmethod mult2n ((a mtrix) (b mtrix))
  65   (if (= (mtrix-dimdom a) (mtrix-dimcodom b))
  66     (make-mtrix
  67       :dimdom (mtrix-dimdom b)
  68       :dimcodom (mtrix-dimcodom a) :elems
  69       (mtrix-mult2n (mtrix-elems a) (mtrix-elems b)))
  70     (throw 'over-ex "Mismatched dimensions for matrix multiplication.")))
  71
  72 (defmethod divis2n ((a mtrix) (b number))
  73   (make-mtrix-like
  74     a (scalar-mtrix-multn
  75         (/ b) (mtrix-elems a))))
  76