[lisplab-cvs] r137 - in trunk/src: core linalg matrix

Jørn Inge Vestgården jivestgarden at common-lisp.net
Sat Mar 20 14:10:07 UTC 2010


Author: jivestgarden
Date: Sat Mar 20 10:10:06 2010
New Revision: 137

Log:
cleaned up matrix predicate methods

Modified:
   trunk/src/core/level0-functions.lisp
   trunk/src/core/level0-interface.lisp
   trunk/src/linalg/level3-linalg-interface.lisp
   trunk/src/matrix/level1-array.lisp
   trunk/src/matrix/level1-matrix.lisp
   trunk/src/matrix/level2-generic.lisp
   trunk/src/matrix/level2-interface.lisp
   trunk/src/matrix/level2-matrix-zge.lisp

Modified: trunk/src/core/level0-functions.lisp
==============================================================================
--- trunk/src/core/level0-functions.lisp	(original)
+++ trunk/src/core/level0-functions.lisp	Sat Mar 20 10:10:06 2010
@@ -19,11 +19,9 @@
 
 (in-package :lisplab)
 
-(defmethod matrix? ((a number)) nil)
+(defmethod matrix-p (x) nil)
 
-(defmethod vector? ((a number)) nil)
-
-(defmethod scalar? ((a number)) t)
+(defmethod vector-p (x) nil)
 
 (defun ^ (x n) "Synonym for expt" (expt x n))
 

Modified: trunk/src/core/level0-interface.lisp
==============================================================================
--- trunk/src/core/level0-interface.lisp	(original)
+++ trunk/src/core/level0-interface.lisp	Sat Mar 20 10:10:06 2010
@@ -35,16 +35,10 @@
 (defgeneric cleanup-threads ()
   (:documentation "Kills unused threads and frees resources."))
 
-;;; Remove scalar? 
-(defgeneric scalar? (x)
-  (:documentation "A scalar is a object with ignored internal structure."))
-
-;;; Change name to vector-p 
-(defgeneric vector? (x)
+(defgeneric vector-p (x)
   (:documentation "A vector is a object whose elements are accessible with vref."))
 
-;;; Change name to matrix-p
-(defgeneric matrix? (x)
+(defgeneric matrix-p (x)
   (:documentation "A matrix is a object whose elements are accesible with mref."))
 
 (defgeneric copy (a)

Modified: trunk/src/linalg/level3-linalg-interface.lisp
==============================================================================
--- trunk/src/linalg/level3-linalg-interface.lisp	(original)
+++ trunk/src/linalg/level3-linalg-interface.lisp	Sat Mar 20 10:10:06 2010
@@ -37,7 +37,7 @@
 (defgeneric mdet (matrix)
   (:documentation "Matrix determinant.")
   (:method :before (m)
-	   (assert (square-matrix? m))))
+	   (assert (= (rows m) (cols m)))))
 
 (defgeneric minv! (a)
   (:documentation "Matrix inverse. Destructive."))
@@ -45,7 +45,7 @@
 (defgeneric minv (a)
   (:documentation "Matrix inverse.")
   (:method :before (m)
-	   (assert (square-matrix? m))))
+	   (assert (= (rows m) (cols m)))))
 
 (defgeneric m* (a b)
   (:documentation "Matrix multiplication.")

Modified: trunk/src/matrix/level1-array.lisp
==============================================================================
--- trunk/src/matrix/level1-array.lisp	(original)
+++ trunk/src/matrix/level1-array.lisp	Sat Mar 20 10:10:06 2010
@@ -19,7 +19,7 @@
 
 (in-package :lisplab)
 
-(defmethod matrix? ((a array))
+(defmethod matrix-p ((a array))
   "True for an array of rank 2"
   (= (rank a) 2))
 

Modified: trunk/src/matrix/level1-matrix.lisp
==============================================================================
--- trunk/src/matrix/level1-matrix.lisp	(original)
+++ trunk/src/matrix/level1-matrix.lisp	Sat Mar 20 10:10:06 2010
@@ -24,11 +24,9 @@
 
 (in-package :lisplab)
 
-(defmethod scalar? ((x matrix-base)) nil)
+(defmethod vector-p ((x matrix-base)) t)
 
-(defmethod vector? ((x matrix-base)) t)
-
-(defmethod matrix? ((x matrix-base)) t)
+(defmethod matrix-p ((x matrix-base)) t)
 
 (defmethod rank ((matrix matrix-base)) 2)
 

Modified: trunk/src/matrix/level2-generic.lisp
==============================================================================
--- trunk/src/matrix/level2-generic.lisp	(original)
+++ trunk/src/matrix/level2-generic.lisp	Sat Mar 20 10:10:06 2010
@@ -20,7 +20,7 @@
 
 ;;; Implementation principles: 
 ;;; - all operators in this film should spezialie for matrix-base and only 
-;;;   asume level0 and level1 generic function (mref, vref, size, dim, etc.) 
+;;;   assume level0 and level1 generic function (mref, vref, size, dim, etc.) 
 ;;; - The methods in this file should not assume anything about implementation of 
 ;;;   the matrices. 
 ;;; - The methds in this file should be as short and clean as possible. 
@@ -36,9 +36,6 @@
   ;; TODO what the dim, should I use it or ignore it
   val)
 
-(defmethod square-matrix? ((x matrix-base))
-  (= (rows x) (cols x)))
-
 ;;; This is OK, but could be optimzied!
 (defmacro w/mat (a args &body body)
   (let ((a2 (gensym))
@@ -251,130 +248,19 @@
   (reshape a (list rows (/ (size a) rows) 1)))
 
 
+(defmethod row-swap! (A i j)
+  (dotimes (c (cols A))
+    (psetf (mref A i c) (mref A j c)
+	   (mref A j c) (mref A i c)))
+  A)
+
+(defmethod row-mul! (A i num)
+  (dotimes (c (cols A))
+    (setf (mref A i c) (.* num (mref A i c))))
+  A)
+
+(defmethod row-add! (A i j num)
+  (dotimes (c (cols A))
+    (setf (mref A i c) (.+ (mref A i c) (.* num (mref A j c)))))
+  A)
 
-
-
-
-
-
-#| OLD
-
-;; Specialize operators for matrix-ge. It is dangerous to spezialize for matrix-base
-;; since the output type depends on the kind of operator. It is possible to 
-;; make it better by separating between complex and real number and matrices, but
-;; I'm too lazy to do it.
-(defmacro def-binary-op-matrix-ge (op)
-  (let ((a (gensym "a"))
-	(b (gensym "b"))
-	(len (gensym "len"))
-	(i (gensym "i")))
-    `(progn
-      (defmethod ,op ((,a matrix-ge) ,b)
-	(let* ((,a (copy ,a))
-	       (,len (size ,a)))
-	  (dotimes (,i ,len)
-	    (setf (vref ,a ,i) (,op (vref ,a ,i) ,b)))
-	  ,a))
-      (defmethod ,op (,a (,b matrix-ge))
-	(let* ((,b (copy ,b))
-	       (,len (size ,b)))
-	  (dotimes (,i ,len)
-	    (setf (vref ,b ,i) (,op ,a (vref ,b ,i))))
-	  ,b))
-      (defmethod ,op ((,a matrix-ge) (,b matrix-ge))
-	(let* ((,a (copy ,a))
-	       (,len (size ,a)))
-	  (dotimes (,i ,len)
-	    (setf (vref ,a ,i) (,op (vref ,a ,i) (vref ,b ,i))))
-	  ,a)))))
-
-(def-binary-op-matrix-ge .add)
-
-(def-binary-op-matrix-ge .mul)
-
-(def-binary-op-matrix-ge .sub)
-
-(def-binary-op-matrix-ge .div)
-
-(def-binary-op-matrix-ge .expt)
-
-(def-binary-op-matrix-ge .min)
-
-(def-binary-op-matrix-ge .max)
-
-|#
-
-#|
-;;; Anything and matrix 
-
-(define-constant +generic-function-anything-matrix-list+
-    '(.add .sub .mul .div .expt .max .min))
-
-(defmacro defmethod-anything-matrix (name)  
-  (let ((a (gensym "a"))
-	(b (gensym "b"))
-	(c (gensym "c"))
-	(i (gensym "i")))
-  `(defmethod ,name (,a (,b matrix-base))
-     (let ((,c (mcreate ,b)))
-       (dotimes (,i (size ,c))
-	 (setf (vref ,c ,i) (,name ,a (vref ,b ,i)))) 
-       ,c))))
-
-(defmacro expand-generic-function-anything-matrix-list ()
-  (cons 'progn
-      (mapcar (lambda (name)
-		`(defmethod-anything-matrix ,name))
-	      +generic-function-anything-matrix-list+)))
-
-(expand-generic-function-anything-matrix-list)
-
-;;; Matrix and anything 
-
-(define-constant +generic-function-matrix-anything-list+
-    '(.add .sub .mul .div .expt .max .min))
-
-(defmacro defmethod-matrix-anything (name)  
-  (let ((a (gensym "a"))
-	(b (gensym "b"))
-	(c (gensym "c"))
-	(i (gensym "i")))
-  `(defmethod ,name ((,a matrix-base) ,b)
-     (let ((,c (mcreate ,a)))
-       (dotimes (,i (size ,c))
-	 (setf (vref ,c ,i) (,name (vref ,a ,i) ,b))) 
-       ,c))))
-
-(defmacro expand-generic-function-matrix-anything-list ()
-  (cons 'progn
-      (mapcar (lambda (name)
-		`(defmethod-matrix-anything ,name))
-	      +generic-function-matrix-anything-list+)))
-
-(expand-generic-function-matrix-anything-list)
-
-;;; Matrix and matrix 
-
-(define-constant +generic-function-matrix-matrix-list+
-    '(.add .sub .mul .div .expt .max .min))
-
-(defmacro defmethod-matrix-matrix (name)  
-  (let ((a (gensym "a"))
-	(b (gensym "b"))
-	(c (gensym "c"))
-	(i (gensym "i")))
-  `(defmethod ,name ((,a matrix-base) (,b matrix-base))
-     (let ((,c (mcreate ,a)))
-       (dotimes (,i (size ,c))
-	 (setf (vref ,c ,i) (,name (vref ,a ,i) (vref ,b ,i)))) 
-       ,c))))
-
-(defmacro expand-generic-function-matrix-matrix-list ()
-  (cons 'progn
-      (mapcar (lambda (name)
-		`(defmethod-matrix-matrix ,name))
-	      +generic-function-matrix-matrix-list+)))
-
-(expand-generic-function-matrix-matrix-list)
-
-|#
\ No newline at end of file

Modified: trunk/src/matrix/level2-interface.lisp
==============================================================================
--- trunk/src/matrix/level2-interface.lisp	(original)
+++ trunk/src/matrix/level2-interface.lisp	Sat Mar 20 10:10:06 2010
@@ -47,9 +47,6 @@
   (:documentation "Creates a new matrix of the same type and with the same value as the other,
 but with all elements set to value."))
 
-(defgeneric square-matrix? (x)
-  (:documentation "True when the matrix is square, obviously."))
-
 (defgeneric diag (v)
   (:documentation "Creates a diagnoal matrix from the vector."))
 
@@ -83,6 +80,18 @@
 (defgeneric get-col (matrix col)
   (:documentation "Gets rows. Destructive"))
 
+;;; Row operations 
+
+(defgeneric row-swap! (matrix i j)
+  (:documentation "Swaps row i and j of matrix. Destructive."))
+
+(defgeneric row-mul! (matrix i number)
+  (:documentation "Multiplies row i with number. Destructive."))
+
+(defgeneric row-add! (matrix i j number)
+  (:documentation "Adds a multiplicum of row j to row i. A_ic=A_ic+number*A_jc. Destructive.")) 
+
+
 ;;;; Views
 
 (defgeneric view-row (matrix row)

Modified: trunk/src/matrix/level2-matrix-zge.lisp
==============================================================================
--- trunk/src/matrix/level2-matrix-zge.lisp	(original)
+++ trunk/src/matrix/level2-matrix-zge.lisp	Sat Mar 20 10:10:06 2010
@@ -161,8 +161,8 @@
 					       (type-spec ,a)
 					       (type-spec ,b))))
 	 ;; Assumes that input is something with a well-defined spec
-	 (,name (if (matrix? ,a) (convert ,a ,spec) ,a)  
-		(if (matrix? ,b) (convert ,b ,spec) ,b))))))
+	 (,name (if (matrix-p ,a) (convert ,a ,spec) ,a)  
+		(if (matrix-p ,b) (convert ,b ,spec) ,b))))))
 			 
 (defmacro def-all-cross-complex-real-methods (name)
   `(progn




More information about the lisplab-cvs mailing list