src/overload/overload.lisp

   1
   2 (defpackage :lineal.overload
   3   (:use :cl)
   4   (:export *accep-table* mtrix tuple
   5            make-tuple tuple-dim tuple-elems
   6            make-mtrix mtrix-dimdom mtrix-dimcodom mtrix-elems
   7            over-format over-ex
   8            addn subtrn multn divisn exptn)
   9   (:import-from
  10     :lineal.math
  11     det
  12     dot-prod
  13     factorial
  14     mtrix-addn
  15     mtrix-augment
  16     mtrix-coltuple-multn
  17     mtrix-inverse
  18     mtrix-multn
  19     mtrix-mult2n
  20     mtrix-square-identity
  21     mtrix-subtrn
  22     mtrix-transpose
  23     nAr nCr nPr
  24     nullspace
  25     output-tuple
  26     output-matrix
  27     r-ef
  28     rr-ef
  29     scalar-mtrix-multn
  30     scalar-tuple-multn
  31     tuple-addn
  32     tuple-cross3
  33     tuple-magnitude
  34     tuple-orth
  35     tuple-proj
  36     tuple-scalar-divisn
  37     tuple-subtrn))
  38
  39 (in-package :lineal.overload)
  40
  41 ;;; Multiplicative Inverse
  42 (defgeneric over-multv-inverse (a))
  43 ;;; Concatenate Horizontally
  44 (defgeneric cat2 (term1 term2))
  45 (defun cat-list (elems)
  46   (if (cdr elems)
  47     (reduce #'cat2 elems :from-end t)
  48     (car elems)))
  49 ;;; Concatenate Vertically (or vector-wise)
  50 (defgeneric vcat2 (a b))
  51 (defun vcat-list (elems)
  52   (if (cdr elems)
  53     (reduce #'vcat2 elems :from-end t)
  54     (car elems)))
  55
  56 (defgeneric over-crop (a b))
  57 (defgeneric over-vcrop (a b))
  58
  59 (defgeneric over-transpose (a))
  60 (defmethod over-transpose (a)
  61   (throw 'over-ex
  62          "You can only tranpose vectors and matrices."))
  63
  64
  65 ;;; Standard operations.
  66 (defgeneric add2n (a b))
  67 (defgeneric subtr2n (a b))
  68 (defgeneric mult2n (a b))
  69 (defgeneric divis2n (a b))
  70 (defgeneric expt2n (a b))
  71
  72 (defun addn (&rest elems)
  73   (reduce #'add2n elems))
  74
  75 (defun subtrn (&rest elems)
  76   (if (cdr elems)
  77     (reduce #'subtr2n elems)
  78     ;V If only one element, follow V
  79     ;V lisp style by negating it.  V
  80     (mult2n -1 (car elems))))
  81
  82 (defun multn (&rest elems)
  83   (reduce #'mult2n elems))
  84
  85 (defun divisn (&rest elems)
  86   (if (cdr elems)
  87     (reduce #'divis2n elems)
  88     (over-multv-inverse (car elems))))
  89
  90 (defun exptn (&rest elems)
  91   (reduce #'expt2n elems))
  92
  93