[lisplab-cvs] r25 - src/matrix system
Jørn Inge Vestgården
jivestgarden at common-lisp.net
Sat May 16 17:55:29 UTC 2009
Author: jivestgarden
Date: Sat May 16 13:55:28 2009
New Revision: 25
Log:
Heavy refactoring. not finished
Added:
src/matrix/level2-matrix-zge.lisp
Modified:
src/matrix/level1-constructors.lisp
src/matrix/level1-generic.lisp
src/matrix/level1-interface.lisp
src/matrix/level1-matrix.lisp
src/matrix/level1-util.lisp
src/matrix/level2-blas-complex.lisp
src/matrix/level2-matrix-dge.lisp
system/lisplab.asd
Modified: src/matrix/level1-constructors.lisp
==============================================================================
--- src/matrix/level1-constructors.lisp (original)
+++ src/matrix/level1-constructors.lisp Sat May 16 13:55:28 2009
@@ -17,4 +17,70 @@
;;; with this program; if not, write to the Free Software Foundation, Inc.,
;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-(in-package :lisplab)
\ No newline at end of file
+(in-package :lisplab)
+
+(export '(mat new col row))
+
+(export '(rmat rnew rcol rrow))
+
+(export '(cmat cnew ccol crow))
+
+
+(defmacro mat (type &body args)
+ "Creates a matrics"
+ `(convert
+ ,(cons 'list (mapcar (lambda (x)
+ (cons 'list x))
+ args))
+ ,type))
+
+(defun col (type &rest args)
+ "Creates a column matrix"
+ (convert (mapcar 'list args) type))
+
+(defun row (type &rest args)
+ "Creates a row matrix"
+ (convert args type))
+
+
+(defmacro rmat (&body args)
+ "Creates a blas-real matrics"
+ `(convert
+ ,(cons 'list (mapcar (lambda (x)
+ (cons 'list x))
+ args))
+
+ 'matrix-dge))
+
+(defun rcol (&rest args)
+ "Creates a blas-real column matrix"
+ (convert (mapcar 'list args) 'matrix-dge))
+
+(defun rrow (&rest args)
+ "Creates a blas-real row matrix"
+ (convert args 'matrix-dge))
+
+(defun rnew (value rows &optional (cols 1))
+ "Creates a new blas-real matrix"
+ (new 'matrix-dge (list rows cols) t value))
+
+(defmacro cmat (&body args)
+ "Creates a blas-complex matrics"
+ `(convert
+ ,(cons 'list (mapcar (lambda (x)
+ (cons 'list x))
+ args))
+
+ 'matrix-zge))
+
+(defun ccol (&rest args)
+ "Creates a blas-complex column matrix"
+ (convert (mapcar 'list args) 'matrix-zge))
+
+(defun crow (&rest args)
+ "Creates a blas-complex row matrix"
+ (convert args 'matrix-zge))
+
+(defun cnew (value rows &optional (cols 1))
+ "Create a new blas-complex matrix"
+ (new 'matrix-zge (list rows cols) t value))
\ No newline at end of file
Modified: src/matrix/level1-generic.lisp
==============================================================================
--- src/matrix/level1-generic.lisp (original)
+++ src/matrix/level1-generic.lisp Sat May 16 13:55:28 2009
@@ -17,30 +17,18 @@
;;; with this program; if not, write to the Free Software Foundation, Inc.,
;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-(in-package :lisplab)
-
-(defmethod new (class dim &optional (element-type t) (value 0))
- ;;; TODO get rid of this default that calls the new constructor
- (mnew class dim element-type value))
-
-(defmethod scalar? (x)
- (numberp x))
-
-(defmethod vector? (x)
- nil)
-(defmethod matrix? (x)
- nil)
-(defmethod size (matrix) (reduce '* (dim matrix)))
+;;; TODO Get rid of this file and have no non-specialized matrix level1 methods
-(defmethod rank (matrix) (length (dim matrix)))
-(defmethod cols (matrix) (dim matrix 0))
+(in-package :lisplab)
-(defmethod rows (matrix) (dim matrix 1))
+#-todo-remove(defmethod new (class dim &optional (element-type t) (value 0))
+ ;;; TODO get rid of this default that calls the new constructor
+ (mnew class dim element-type value))
-(defmethod convert (obj type)
+#+todo-remove(defmethod convert (obj type)
(if (not (or (vector? obj) (matrix? obj)))
(coerce obj type)
(let ((new (new type (dim obj) (element-type obj))))
@@ -52,7 +40,7 @@
(setf (mref new i j) (mref obj i j))))))
new)))
-(defmethod copy (a)
+#+todo-remove(defmethod copy (a)
(typecase a
(list (copy-list a))
(sequence (copy-seq a))
@@ -61,6 +49,15 @@
(setf (vref b i) (vref a i)))
b))))
+#-todo-remove(defmethod create (a &optional value dim)
+ (unless dim (setf dim (dim a)))
+ (unless (consp dim) (setf dim (list dim 1)))
+ (if value
+ (new (class-name (class-of a)) dim (element-type a) value)
+ (new (class-name (class-of a)) dim)))
+
+
+;;; This is OK, but could be optimzied!
(defmacro w/mat (a args &body body)
(let ((a2 (gensym))
(x (first args))
@@ -73,27 +70,3 @@
(setf (mref ,a2 ,i ,j)
, at body))))
,a2)))
-
-(defmacro mat (type &body args)
- "Creates a matrics"
- `(convert
- ,(cons 'list (mapcar (lambda (x)
- (cons 'list x))
- args))
- ,type))
-
-(defun col (type &rest args)
- "Creates a column matrix"
- (convert (mapcar 'list args) type))
-
-(defun row (type &rest args)
- "Creates a row matrix"
- (convert args type))
-
-(defmethod create (a &optional value dim)
- (unless dim (setf dim (dim a)))
- (unless (consp dim) (setf dim (list dim 1)))
- (if value
- (new (class-name (class-of a)) dim (element-type a) value)
- (new (class-name (class-of a)) dim)))
-
Modified: src/matrix/level1-interface.lisp
==============================================================================
--- src/matrix/level1-interface.lisp (original)
+++ src/matrix/level1-interface.lisp Sat May 16 13:55:28 2009
@@ -21,7 +21,10 @@
(in-package :lisplab)
(export '(*lisplab-print-size*
- vector? matrix? new mnew ref mref vref
+ vector? matrix?
+ new mnew
+ create mcreate
+ ref mref vref
dim element-type create
size rank rows cols ))
@@ -66,9 +69,17 @@
(defgeneric (setf element-type) (value matrix))
(defgeneric create (a &optional value dim)
+ (:documentation "Deprecated. Use mcreate in stead. Creates a new matrix of the same type and with the same value as the other,
+but with all elements set to value."))
+
+(defgeneric mcreate (a &optional value dim)
(: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 mmcreate (a b &optional value dim)
+ (:documentation "Creates a new matrix. The new matrix has a type derived from a and b,
+and all elements set to value."))
+
(defgeneric size (matrix)
(:documentation "Gives the number of elements in the object."))
Modified: src/matrix/level1-matrix.lisp
==============================================================================
--- src/matrix/level1-matrix.lisp (original)
+++ src/matrix/level1-matrix.lisp Sat May 16 13:55:28 2009
@@ -22,6 +22,14 @@
;;; Generic methods
+(defmethod scalar? ((x matrix-base)) nil)
+
+(defmethod vector? ((x matrix-base)) t)
+
+(defmethod matrix? ((x matrix-base)) t)
+
+(defmethod rank ((matrix matrix-base)) 2)
+
(defmethod dim ((matrix matrix-base) &optional direction)
(if direction
(ecase direction
@@ -43,10 +51,25 @@
(when (< rows (rows matrix))
(format stream "...~%")))))
+(defmethod mcreate ((a matrix-base) &optional (value 0) dim)
+ (unless dim
+ (setf dim (dim a)))
+ (make-matrix-instance (class-of a) dim value))
+
+(defmethod mmcreate ((a matrix-base) (b matrix-base) &optional (value 0) dim)
+ ;; TODO make real implmentaiton of this
+ (unless dim
+ (setf dim (dim a)))
+ (if (or (equal '(complex double-float) (element-type a))
+ (equal '(complex double-float) (element-type b)))
+ (make-matrix-instance 'matrix-zge dim value)
+ (make-matrix-instance 'matrix-dge dim value)))
+
;;; Spcialized for blas-dge
(defmethod mnew ((class (eql 'matrix-dge)) dim &optional (element-type t) (value 0))
- (make-matrix-new-instance class dim element-type value))
+ (declare (ignore element-type))
+ (make-matrix-instance class dim value))
(defmethod mref ((matrix matrix-base-dge) row col)
(aref (the type-blas-store (matrix-store matrix))
@@ -70,6 +93,10 @@
;;; Spcialized for blas-zge
+(defmethod mnew ((class (eql 'matrix-zge)) dim &optional (element-type t) (value 0))
+ (declare (ignore element-type))
+ (make-matrix-instance class dim value))
+
(defmethod mref ((matrix matrix-base-zge) row col)
(ref-blas-complex-store (matrix-store matrix)
(column-major-idx row col (rows matrix))
Modified: src/matrix/level1-util.lisp
==============================================================================
--- src/matrix/level1-util.lisp (original)
+++ src/matrix/level1-util.lisp Sat May 16 13:55:28 2009
@@ -20,8 +20,7 @@
(in-package :lisplab)
-(defun make-matrix-new-instance (class dim &optional (element-type t) (value 0))
- (declare (ignore element-type))
+(defun make-matrix-instance (class dim value)
(unless (consp dim) (setf dim (list dim 1)))
(let ((rows (car dim))
(cols (if (cdr dim) (cadr dim) 1)))
@@ -30,7 +29,6 @@
:rows rows
:cols cols)))
-
(deftype type-blas-store ()
'(simple-array double-float (*)))
Modified: src/matrix/level2-blas-complex.lisp
==============================================================================
--- src/matrix/level2-blas-complex.lisp (original)
+++ src/matrix/level2-blas-complex.lisp Sat May 16 13:55:28 2009
@@ -23,8 +23,7 @@
(make-instance 'blas-complex
:store (copy (store matrix))
:rows (rows matrix)
- :cols (cols matrix)
- :size (size matrix)))
+ :cols (cols matrix)))
(defmethod convert ((a blas-complex) 'blas-real)
(let* ((b (rnew 0 (rows a) (cols a)))
Modified: src/matrix/level2-matrix-dge.lisp
==============================================================================
--- src/matrix/level2-matrix-dge.lisp (original)
+++ src/matrix/level2-matrix-dge.lisp Sat May 16 13:55:28 2009
@@ -1,5 +1,5 @@
;;; Lisplab, level2-matrix-dge.lisp
-;;; Optimizations for blas real matrices.
+;;; Optimizations for real matrices.
;;; Copyright (C) 2009 Joern Inge Vestgaarden
;;;
@@ -19,7 +19,7 @@
(in-package :lisplab)
-(defmethod copy ((matrix matrix-base-dge))
+(defmethod copy ((matrix matrix-base-dge))
(make-instance (class-name (class-of matrix))
:store (copy-seq (matrix-store matrix))
:rows (rows matrix)
Added: src/matrix/level2-matrix-zge.lisp
==============================================================================
--- (empty file)
+++ src/matrix/level2-matrix-zge.lisp Sat May 16 13:55:28 2009
@@ -0,0 +1,109 @@
+;;; Lisplab, level2-matrix-zge.lisp
+;;; Optimizations for complex matrices.
+
+
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License along
+;;; with this program; if not, write to the Free Software Foundation, Inc.,
+;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+(in-package :lisplab)
+
+(defmethod copy ((matrix matrix-base-zge))
+ (make-instance (class-name (class-of matrix))
+ :store (copy-seq (matrix-store matrix))
+ :rows (rows matrix)
+ :cols (cols matrix)))
+
+(defmacro def-binary-op-blas-complex (new old)
+ ;;; TODO speed up for real numbers
+ (let ((a (gensym "a"))
+ (b (gensym "b"))
+ (len (gensym "len"))
+ (store (gensym "store"))
+ (store2 (gensym "store2"))
+ (i (gensym "i")))
+ `(progn
+ (defmethod ,new ((,a matrix-zge) ,b)
+ (let* ((,a (copy ,a))
+ (,store (matrix-store ,a))
+ (,b (coerce ,b '(complex double-float)))
+ (,len (size ,a)))
+ (declare (type (complex double-float) ,b)
+ (type type-blas-store ,store)
+ (type type-blas-idx ,len))
+ (dotimes (,i ,len)
+ (setf (ref-blas-complex-store ,store ,i 0 ,len)
+ (,old (ref-blas-complex-store ,store ,i 0 ,len) ,b)))
+ ,a))
+ (defmethod ,new (,a (,b matrix-zge))
+ (let* ((,b (copy ,b))
+ (,store (matrix-store ,b))
+ (,a (coerce ,a '(complex double-float)))
+ (,len (size ,b)))
+ (declare (type (complex double-float) ,a)
+ (type type-blas-store ,store)
+ (type type-blas-idx ,len))
+ (dotimes (,i ,len)
+ (setf (ref-blas-complex-store ,store ,i 0 ,len)
+ (,old ,a (ref-blas-complex-store ,store ,i 0 ,len))))
+ ,b))
+ (defmethod ,new ((,a matrix-zge) (,b matrix-zge))
+ (let* ((,a (copy ,a))
+ (,store (matrix-store ,a))
+ (,store2 (matrix-store ,b))
+ (,len (size ,a)))
+ (declare (type type-blas-store ,store)
+ (type type-blas-store ,store2)
+ (type type-blas-idx ,len))
+ (dotimes (,i ,len)
+ (setf (ref-blas-complex-store ,store ,i 0 ,len)
+ (,old (ref-blas-complex-store ,store ,i 0 ,len)
+ (ref-blas-complex-store ,store2 ,i 0 ,len))))
+ ,a))
+ (defmethod ,new ((,a matrix-zge) (,b matrix-dge))
+ (let* ((,a (copy ,a))
+ (,store (matrix-store ,a))
+ (,store2 (matrix-store ,b))
+ (,len (size ,a)))
+ (declare (type type-blas-store ,store)
+ (type type-blas-store ,store2)
+ (type type-blas-idx ,len))
+ (dotimes (,i ,len)
+ (setf (ref-blas-complex-store ,store ,i 0 ,len)
+ (,old (ref-blas-complex-store ,store ,i 0 ,len)
+ (aref ,store2 ,i))))
+ ,a))
+ (defmethod ,new ((,a matrix-dge) (,b matrix-zge))
+ (let* ((,b (copy ,b))
+ (,store (matrix-store ,a))
+ (,store2 (matrix-store ,b))
+ (,len (size ,a)))
+ (declare (type type-blas-store ,store)
+ (type type-blas-store ,store2)
+ (type type-blas-idx ,len))
+ (dotimes (,i ,len)
+ (setf (ref-blas-complex-store ,store2 ,i 0 ,len)
+ (,old (aref ,store ,i)
+ (ref-blas-complex-store ,store2 ,i 0 ,len))))
+ ,b)))))
+
+(def-binary-op-blas-complex .add +)
+
+(def-binary-op-blas-complex .mul *)
+
+(def-binary-op-blas-complex .sub -)
+
+(def-binary-op-blas-complex .div /)
+
+(def-binary-op-blas-complex .expt expt)
+
Modified: system/lisplab.asd
==============================================================================
--- system/lisplab.asd (original)
+++ system/lisplab.asd Sat May 16 13:55:28 2009
@@ -31,23 +31,42 @@
:serial t
:components
(
- (:file "level1-interface")
- (:file "level1-util")
- (:file "level1-generic")
- (:file "level1-array")
- (:file "level1-list")
- (:file "level1-blas")
- (:file "level1-blas-real")
- (:file "level1-blas-complex")
- (:file "level1-funmat")
-
- (:file "level2-interface")
- (:file "level2-array-functions")
- (:file "level2-generic")
- (:file "level2-funmat")
- (:file "level2-blas")
- (:file "level2-blas-real")
- (:file "level2-blas-complex")))
+ (:file "level1-interface")
+
+ (:file "level1-array")
+
+ (:file "level1-util")
+ (:file "level1-classes")
+ (:file "level1-matrix")
+ (:file "level1-constructors")
+
+ (:file "level2-interface")
+
+ (:file "level2-matrix-dge")
+ (:file "level2-matrix-zge")
+
+ (:file "level2-array-functions")
+
+; (:file "level1-interface")
+; (:file "level1-util")
+; (:file "level1-generic")
+; (:file "level1-array")
+; (:file "level1-list")
+
+
+; (:file "level1-blas")
+; (:file "level1-blas-real")
+; (:file "level1-blas-complex")
+; (:file "level1-funmat")
+
+; (:file "level2-interface")
+; (:file "level2-array-functions")
+; (:file "level2-generic")
+; (:file "level2-funmat")
+; (:file "level2-blas")
+; (:file "level2-blas-real")
+; (:file "level2-blas-complex")
+ ))
;;
;; Linear algebra interface(Level 3)
@@ -63,7 +82,7 @@
;;
;; Linear algebra lisp implementation (Level 3)
;;
- (:module :linalg-native
+ #+nil (:module :linalg-native
:depends-on (:matrix :linalg-interface)
:pathname "../src/linalg/"
:serial t
@@ -75,7 +94,7 @@
;;
;; Fast Fourier transform (Level 3)
;;
- (:module :fft
+ #+nil (:module :fft
:depends-on (:matrix)
:pathname "../src/fft/"
:serial t
@@ -100,7 +119,7 @@
;;
;; Blas and Lapack implmentations (Level 3)
;;
- (:module :matlisp
+ #+nil (:module :matlisp
:depends-on (:matrix :linalg-interface)
:pathname "../src/matlisp/"
:serial t
More information about the lisplab-cvs
mailing list