src/overload/overload.lisp

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