Skip to content

Commit

Permalink
removed a whole slew of silly functions which are in lisp-matrix. The…
Browse files Browse the repository at this point in the history 
… rest need to be confirmed, though I think they are there.
  • Loading branch information
@blindglobe
blindglobe committed Dec 11, 2008
1 parent b27ab2f commit 68d4e6f
Showing 1 changed file with 0 additions and 247 deletions.
247 changes: 0 additions & 247 deletions src/numerics/matrices.lsp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,6 @@

(in-package :lisp-stat-matrix)

(deftype matrix () 'array) ;; temp fix

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
Expand All @@ -38,160 +37,13 @@ Displaces vector V to array with dimensions DIMS"
:displaced-to v
:element-type (array-element-type v)))

;;;;

(defun check-matrix (a)
(if (not (and (typep a' array)
(= (array-rank a) 2)))
(error "not a matrix - ~s" a)
t))

(defun check-square-matrix (a)
(if (and (check-matrix a)
(/= (array-dimension a 0) (array-dimension a 1))
(error "matrix not square - ~s" a))
t))

(defun matrixp (x)
"Args: (x)
Returns:
T if X is a 2-d array (i.e. a matrix),
NIL otherwise."
(and (typep x 'array)
(= (array-rank x) 2)))

(defun num-rows (x)
"Args: (x)
Returns number of rows in X."
(if (matrixp x)
(array-dimension x 0)
(error "only useful for matrices.")))

(defun num-cols (x)
"Args: (x)
Returns number of columns in X."
(if (matrixp x)
(array-dimension x 1)
(error "only useful for matrices.")))


;;; Look at this! Prime target for generic function dispatch!
(defun matmult (a b &rest args)
"Args: (a b &rest args)
Returns the matrix product of matrices a, b, etc. If a is a vector it is
treated as a row vector; if b is a vector it is treated as a column vector."
;; fixme: why does SBCL claim this is unreachable?
(let ((rtype (cond ((and (typep a 'matrix)
(typep b 'matrix)) 'matrix)
((and (typep a 'matrix)
(typep b 'sequence)) 'vector)
((and (typep a 'sequence)
(typep b 'matrix)) 'vector)
((and (typep a 'sequence)
(typep b 'sequence)) 'number)
((typep a 'sequence)
(if (consp a) 'list 'vector))
((typep b 'sequence)
(if (consp b) 'list 'vector)))))

(if (typep a 'sequence)
(setf a (vector-to-array (coerce a 'vector) (list 1 (length a)))))
(if (typep b 'sequence)
(setf b (vector-to-array (coerce b 'vector) (list (length b) 1))))
(if (not (= (array-dimension a 1) (array-dimension b 0)))
(error "dimensions do not match"))
(if args
(reduce #'matmult args :initial-value (matmult a b))
(let* ((n (array-dimension a 0))
(m (array-dimension b 1))
(p (array-dimension a 1))
(c (make-array (list n m)))
x)
(declare (fixnum n m p))
(dotimes (i n)
(declare (fixnum i))
(dotimes (j m)
(declare (fixnum j))
(setq x 0)
(dotimes (k p)
(declare (fixnum k))
(setq x (+ x
(* (aref a i k)
(aref b k j)))))
(setf (aref c i j) x)))
(case rtype
(matrix c)
(number (aref c 0 0))
(t (coerce (compound-data-seq c) rtype)))))))

(defun identity-matrix (n)
"Args: (n)
Returns the identity matrix of rank N."
(let ((result (make-array (list n n) :initial-element 0)))
(dotimes (i n result)
(declare (fixnum i))
(setf (aref result i i) 1))))

;; this thing is not very efficient at this point - too much coercing
(defun diagonal (x)
"Args: (x)
If X is a matrix, returns the diagonal of X. If X is a sequence, returns a
diagonal matrix of rank (length X) with diagonal elements eq to the elements
of X."
(cond ((typep x 'matrix)
(let* ((n (min (num-rows x) (num-cols x)))
(result (make-array n)))
(dotimes (i n (coerce result 'list))
(setf (aref result i) (aref x i i)))))
((typep x 'sequence)
(let* ((x (coerce x 'vector))
(n (length x))
(result (make-array (list n n) :initial-element 0)))
(dotimes (i n result)
(setf (aref result i i) (aref x i)))))
(t (error "argument must be a matrix or a sequence"))))

(defun row-list (x)
"Args: (m)
Returns a list of the rows of M as vectors"
(check-matrix x)
(let ((m (num-rows x))
(n (num-cols x))
(result nil))
(declare (fixnum m n))
(flet ((get-row (k)
(declare (fixnum k))
(let ((row (make-array n)))
(dotimes (i n row)
(declare (fixnum i))
(setf (aref row i) (aref x k i))))))
(dotimes (i m result)
(declare (fixnum i))
(setf result (cons (get-row (- m i 1)) result))))))

(defun column-list (x)
"Args: (m)
Returns a list of the columns of M as vectors"
(check-matrix x)
(let ((m (num-rows x))
(n (num-cols x))
(result nil))
(declare (fixnum m n))
(flet ((get-col (k)
(declare (fixnum k))
(let ((col (make-array m)))
(dotimes (i m col)
(declare (fixnum i))
(setf (aref col i) (aref x i k))))))
(dotimes (i n result)
(declare (fixnum i))
(setf result (cons (get-col (- n i 1)) result))))))

(defun inner-product (x y)
"Args: (x y)
Expand Down Expand Up @@ -282,103 +134,4 @@ Returns the transpose of the matrix M."
(declare (fixnum j))
(setf (aref tx j i) (aref x i j))))))))

(defun bind-columns (&rest args)
"Args (&rest args)
The ARGS can be matrices, vectors, or lists. Arguments are bound into a matrix
along their columns. Example:
(bind-columns #2a((1 2)(3 4)) #(5 6)) returns #2a((1 2 5)(3 4 6))"

(flet ((check-arg (x)
(if (not (or (typep x 'sequence) (typep x 'matrix)))
(error "bad argument type")))
(arg-cols (x) (if (typep x 'sequence) 1 (num-cols x)))
(arg-rows (x) (if (typep x 'sequence) (length x) (num-rows x))))
(dolist (x args) (check-arg x)) ;; verify data structure conformance.
(let ((m (arg-rows (first args)))
(n (arg-cols (first args))))
(declare (fixnum m n))
(dolist (x (rest args))
(if (/= m (arg-rows x)) (error "column lengths do not match"))
(incf n (arg-cols x)))
(do* ((result (make-array (list m n)))
(args args (rest args))
(firstcol 0)
(x (first args) (first args)))
((null args) result)
(cond
((typep x 'sequence)
(let ((cx (make-next-element x)))
(dotimes (i m)
(setf (aref result i firstcol) (get-next-element cx i)))))
(t
(let ((k (arg-cols x)))
(dotimes (i m)
(dotimes (j k)
(setf (aref result i (+ firstcol j)) (aref x i j)))))))
(incf firstcol (arg-cols x))))))

(defun bind-rows (&rest args)
"Args (&rest args)
The ARGS can be matrices, vectors, or lists. Arguments are bound into a matrix
along their rows. Example:
(bind-rows #2a((1 2)(3 4)) #(5 6)) returns #2a((1 2)(3 4)(5 6))"

(flet ((check-arg (x)
(if (not (or (typep x 'sequence)
(typep x 'matrix)))
(error "bad argument type")))
(arg-cols (x) (if (typep x 'sequence) (length x) (num-cols x)))
(arg-rows (x) (if (typep x 'sequence) 1 (num-rows x))))
(dolist (x args) (check-arg x))
(let ((m (arg-rows (first args)))
(n (arg-cols (first args))))
(declare (fixnum m n))
(dolist (x (rest args))
(if (/= n (arg-cols x)) (error "row lengths do not match"))
(incf m (arg-rows x)))
(do* ((result (make-array (list m n)))
(args args (rest args))
(firstrow 0)
(x (first args) (first args)))
((null args) result)
(cond
((typep x 'sequence)
(let ((cx (make-next-element x)))
(dotimes (i n)
(setf (aref result firstrow i) (get-next-element cx i)))))
(t
(let ((k (arg-rows x)))
(dotimes (i n)
(dotimes (j k)
(setf (aref result (+ firstrow j) i) (aref x j i)))))))
(incf firstrow (arg-rows x))))))


;;;
;;; Copying Functions
;;;

(defun copy-vector (x)
"Args: (x)
Returns a copy of the vector X"
(copy-seq x))

(defun copy-array (a)
"Args: (a)
Returns a copy of the array A"
(vector-to-array (copy-seq (array-data-vector a))
(array-dimensions a)))


#|
(defgeneric copy (x)
(:documentation "methods for copying linaar algebra forms."))
(defmethod copy ((x vector)))

(defmethod copy ((x matrix)))
|#

0 comments on commit 68d4e6f

Please sign in to comment.