[lisplab-cvs] r178 - in trunk/src: linalg matrix
Jørn Inge Vestgården
jivestgarden at common-lisp.net
Wed Sep 1 18:51:00 UTC 2010
Author: jivestgarden
Date: Wed Sep 1 14:50:59 2010
New Revision: 178
Log:
Applied patches from Jan Moringen
Modified:
trunk/src/linalg/level3-linalg-dge.lisp
trunk/src/linalg/level3-linalg-generic.lisp
trunk/src/linalg/level3-linalg-interface.lisp
trunk/src/matrix/level1-funmat.lisp
trunk/src/matrix/level2-generic.lisp
trunk/src/matrix/level2-interface.lisp
trunk/src/matrix/level2-matrix-dge.lisp
trunk/src/matrix/level2-operator.lisp
trunk/src/matrix/level2-view.lisp
Modified: trunk/src/linalg/level3-linalg-dge.lisp
==============================================================================
--- trunk/src/linalg/level3-linalg-dge.lisp (original)
+++ trunk/src/linalg/level3-linalg-dge.lisp Wed Sep 1 14:50:59 2010
@@ -1,4 +1,4 @@
-;;; Lisplab, level3-generic.lisp
+;;; Lisplab, level3-linalg-dge.lisp
;;; Non-spcialized matrix methods.
;;; Copyright (C) 2009 Joern Inge Vestgaarden
@@ -150,22 +150,21 @@
(LU-solve!-blas-real LU b2 0))))
(defun minv!-blas-real (A)
- (let ((LU (copy A))
- (N (rows A)))
- (destructuring-bind (LU p det)
- (LU-factor! LU (make-permutation-vector N))
- (mfill A 0)
- (dotimes (i N)
- (setf (mref A i (vref p i)) 1)
- (LU-solve!-blas-real LU A (vref p i)))))
+ (let ((N (rows A)))
+ (if (= N 1)
+ (setf (mref A 0 0) (/ 1 (mref A 0 0)))
+ (let ((LU (copy A)))
+ (destructuring-bind (LU p det)
+ (LU-factor! LU (make-permutation-vector N))
+ (declare (ignore det))
+ (mfill A 0)
+ (dotimes (i N)
+ (setf (mref A i (vref p i)) 1)
+ (LU-solve!-blas-real LU A (vref p i)))))))
A)
-
+
(defmethod minv! ((A matrix-base-dge))
(minv!-blas-real A))
(defmethod minv ((A matrix-base-dge))
(minv! (copy A)))
-
-
-
-
\ No newline at end of file
Modified: trunk/src/linalg/level3-linalg-generic.lisp
==============================================================================
--- trunk/src/linalg/level3-linalg-generic.lisp (original)
+++ trunk/src/linalg/level3-linalg-generic.lisp Wed Sep 1 14:50:59 2010
@@ -1,4 +1,4 @@
-;;; Lisplab, level3-generic.lisp
+;;; Lisplab, level3-linalg-generic.lisp
;;; Non-spcialized matrix methods.
;;; Copyright (C) 2009 Joern Inge Vestgaarden
Modified: trunk/src/linalg/level3-linalg-interface.lisp
==============================================================================
--- trunk/src/linalg/level3-linalg-interface.lisp (original)
+++ trunk/src/linalg/level3-linalg-interface.lisp Wed Sep 1 14:50:59 2010
@@ -1,4 +1,4 @@
-;;; Lisplab, level2-description.lisp
+;;; Lisplab, level3-linalg-interface.lisp
;;; Matrix generic functions.
;;; Copyright (C) 2009 Joern Inge Vestgaarden
Modified: trunk/src/matrix/level1-funmat.lisp
==============================================================================
--- trunk/src/matrix/level1-funmat.lisp (original)
+++ trunk/src/matrix/level1-funmat.lisp Wed Sep 1 14:50:59 2010
@@ -62,3 +62,17 @@
(defmethod (setf vref) (value (f function-matrix) idx)
(funcall (function-matrix-set-vref f) value f idx))
+
+
+;;; constructor
+;;
+
+(defmethod mcreate ((a function-matrix)
+ &optional (value 0) (dim (dim a)))
+ "DOC"
+ (make-matrix-instance
+ (list (element-type-spec a)
+ (structure-spec a)
+ :any)
+ dim
+ value))
Modified: trunk/src/matrix/level2-generic.lisp
==============================================================================
--- trunk/src/matrix/level2-generic.lisp (original)
+++ trunk/src/matrix/level2-generic.lisp Wed Sep 1 14:50:59 2010
@@ -18,17 +18,17 @@
;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-;;; Implementation principles:
-;;; - all operators in this film should spezialie for matrix-base and only
-;;; 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.
+;;; Implementation principles:
+;;; - all operators in this film should specialize for matrix-base and only
+;;; 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 methods in this file should be as short and clean as possible.
;;; - Avoid optimizations (Exept: call other level2 functions, such as mmap, as much as possible.)
-;;;
+;;;
-(in-package :lisplab)
+(in-package :lisplab)
;;; This is OK, but could be optimzied!
(defmacro w/mat (a args &body body)
Modified: trunk/src/matrix/level2-interface.lisp
==============================================================================
--- trunk/src/matrix/level2-interface.lisp (original)
+++ trunk/src/matrix/level2-interface.lisp Wed Sep 1 14:50:59 2010
@@ -133,22 +133,22 @@
(:documentation "Sums all matrix elements."))
(defgeneric mmin (m)
- (:documentation "Retuns the smalles matrix element and its vector index."))
+ (:documentation "Returns the smallest matrix element and its vector index."))
(defgeneric mmax (m)
- (:documentation "Retuns the largest matrix element and its vector index."))
+ (:documentation "Returns the largest matrix element and its vector index."))
(defgeneric mabsmin (m)
- (:documentation "Retuns the matrix element closest to zero and its vector index."))
+ (:documentation "Returns the matrix element closest to zero and its vector index."))
(defgeneric mabsmax (m)
- (:documentation "Retuns the matrix element with largest absolute value and its vector index."))
+ (:documentation "Returns the matrix element with largest absolute value and its vector index."))
(defgeneric mminmax (m)
- (:documentation "Retuns a list with (minumum maximum)"))
+ (:documentation "Returns a list with (minimum maximum)"))
(defgeneric circ-shift (m shifts)
- (:documentation "Shifts the matrix with periodic indecices"))
+ (:documentation "Shifts the matrix with periodic indices"))
(defgeneric pad-shift (m shifts &optional value)
(:documentation "Shifts the matrix and pads results"))
@@ -156,10 +156,10 @@
(defgeneric mreverse (m)
(:documentation "Reverts elements of matrix or vector. Similar to cl:reverse"))
-;; Some vector functions
+;; Some vector functions
(defgeneric vcross (a b)
- (:documentation "Cross product. Must be a vecotors of length 3"))
+ (:documentation "Cross product. Must be a vectors of length 3"))
(defgeneric vdot (a b)
(:documentation "Dot product of vectors"))
Modified: trunk/src/matrix/level2-matrix-dge.lisp
==============================================================================
--- trunk/src/matrix/level2-matrix-dge.lisp (original)
+++ trunk/src/matrix/level2-matrix-dge.lisp Wed Sep 1 14:50:59 2010
@@ -244,7 +244,7 @@
(unless (zerop mod)
(return-from all-integer-elements-p nil))))
t)
-
+
(defmethod .expt ((a matrix-base-dge) (b matrix-base-dge))
(cond ((>= (mmin a) 0d0)
(let ((c (mcreate a)))
@@ -269,8 +269,8 @@
(defmethod .expt ((a matrix-base-dge) (b real))
"There is a lot of fuzz going on in here. The reason is because
-the important special cases of exponents -3,-2,-1,0,1,2,3 are a factor 10 faster
-than the general case on SBCL. Furthermor, output can be complex for non-integer exponent."
+the important special cases of exponents -3,-2,-1,0,1,2,3 are a factor 10 faster
+than the general case on SBCL. Furthermore, output can be complex for non-integer exponent."
(multiple-value-bind (div mod) (truncate b)
(if (= 0 mod)
(let ((c (mcreate a)))
Modified: trunk/src/matrix/level2-operator.lisp
==============================================================================
--- trunk/src/matrix/level2-operator.lisp (original)
+++ trunk/src/matrix/level2-operator.lisp Wed Sep 1 14:50:59 2010
@@ -85,15 +85,9 @@
(defmacro defmethod-operator-matrix-matrix (name)
(let ((a (gensym))
- (b (gensym))
- (out (gensym))
- (type-a (gensym)))
+ (b (gensym)))
`(defmethod ,name ((,a matrix-base) (,b matrix-base))
- (let* ((,type-a (class-of ,a))
- ;; Let the default be the type of the first matrix. Not sure about this.
- ;; Maybe I should flag an error
- (,out (make-matrix-instance ,type-a (dim ,a) 0)))
- (mmap-operator #',name ,a ,b ,out)))))
+ (mmap-operator #',name ,a ,b (mcreate ,a)))))
(defmacro defmethod-operator-matrix-any (name)
(let ((a (gensym))
Modified: trunk/src/matrix/level2-view.lisp
==============================================================================
--- trunk/src/matrix/level2-view.lisp (original)
+++ trunk/src/matrix/level2-view.lisp Wed Sep 1 14:50:59 2010
@@ -49,11 +49,11 @@
:mref #'(lambda (x i j)
(declare (ignore x i))
(mref matrix row j))
- :set-mref #'(lambda (value x i j)
- (declare (ignore x j))
- (setf (mref matrix row i) value))
- :vref #'(lambda (x i)
- (declare (ignore x))
+ :set-mref #'(lambda (value x i j)
+ (declare (ignore x i))
+ (setf (mref matrix row j) value))
+ :vref #'(lambda (x i)
+ (declare (ignore x))
(mref matrix row i))
:set-vref #'(lambda (value x i)
(declare (ignore x))
@@ -82,9 +82,7 @@
(make-instance 'function-matrix
:rows (cols matrix)
:cols (rows matrix)
- :size (size matrix)
- :element-type (element-type matrix)
- :mref #'(lambda (x i j)
+ :mref #'(lambda (x i j)
(declare (ignore x))
(mref matrix j i))
:set-mref #'(lambda (value x i j)
More information about the lisplab-cvs
mailing list