[lisplab-cvs] r27 - in src: matlisp matrix
Jørn Inge Vestgården
jivestgarden at common-lisp.net
Wed May 20 20:05:58 UTC 2009
Author: jivestgarden
Date: Wed May 20 16:05:54 2009
New Revision: 27
Log:
refactored. Almost finished
Modified:
src/matlisp/geev.lisp
src/matrix/level1-classes.lisp
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-generic.lisp
src/matrix/level2-interface.lisp
Modified: src/matlisp/geev.lisp
==============================================================================
--- src/matlisp/geev.lisp (original)
+++ src/matlisp/geev.lisp Wed May 20 16:05:54 2009
@@ -102,8 +102,8 @@
(xxx (allocate-real-store 1))
(wr (allocate-real-store n))
(wi (allocate-real-store n))
- (vl (if vl-mat (store vl-mat) xxx))
- (vr (if vr-mat (store vr-mat) xxx))
+ (vl (if vl-mat (matrix-store vl-mat) xxx))
+ (vr (if vr-mat (matrix-store vr-mat) xxx))
(lwork (dgeev-workspace-size n (if vl-mat t nil) (if vr-mat t nil) ))
(work (allocate-real-store lwork)))
(multiple-value-bind (a wr wi vl vr work info)
Modified: src/matrix/level1-classes.lisp
==============================================================================
--- src/matrix/level1-classes.lisp (original)
+++ src/matrix/level1-classes.lisp Wed May 20 16:05:54 2009
@@ -1,6 +1,5 @@
;;; Lisplab, level1-classes.lisp
;;; Level1, matrix classes
-;;;
;;; Copyright (C) 2009 Joern Inge Vestgaarden
;;;
@@ -18,8 +17,40 @@
;;; with this program; if not, write to the Free Software Foundation, Inc.,
;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+;;; The class structure is inspired by the stream example
+;;; in Object-Oriented programming in Common Lisp, by Sonja E. Keene.
+
+
(in-package :lisplab)
+;; A scheme for matrix creations
+
+(defvar *matrix-class-to-description* (make-hash-table))
+(defvar *matrix-description-to-class* (make-hash-table :test #'equal))
+
+(defun add-matrix-class (class element-type structure implementation)
+ (setf (gethash (list element-type structure implementation)
+ *matrix-description-to-class*)
+ class
+ (gethash class
+ *matrix-class-to-description* )
+ (list element-type structure implementation)))
+
+(defun find-matrix-class (description)
+ (let* ((entry (gethash description
+ *matrix-description-to-class*)))
+ (unless entry
+ (error "No matrix of structure ~A." description))
+ entry))
+
+(defun find-matrix-description (class)
+ (let* ((entry (gethash class
+ *matrix-class-to-description*)))
+ (unless entry
+ (error "No matrix description of class ~A." class))
+ entry))
+
+
(defclass matrix-base () ())
;;; The matrix element tells the element type of the matrix
@@ -172,5 +203,20 @@
+;;; Adding all the matrix descriptions
+
+(add-matrix-class 'matrix-base-dge :d :ge :base)
+(add-matrix-class 'matrix-lisp-dge :d :ge :lisp)
+(add-matrix-class 'matrix-blas-dge :d :ge :blas)
+(add-matrix-class 'matrix-dge :d :ge :any)
+
+(add-matrix-class 'matrix-base-zge :z :ge :base)
+(add-matrix-class 'matrix-lisp-zge :z :ge :lisp)
+(add-matrix-class 'matrix-blas-zge :z :ge :blas)
+(add-matrix-class 'matrix-zge :z :ge :any)
+
+;;; TODO the other types need also conventions
+
+
Modified: src/matrix/level1-constructors.lisp
==============================================================================
--- src/matrix/level1-constructors.lisp (original)
+++ src/matrix/level1-constructors.lisp Wed May 20 16:05:54 2009
@@ -17,6 +17,9 @@
;;; with this program; if not, write to the Free Software Foundation, Inc.,
;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+;;; TODO: should be level2 not level1
+
+
(in-package :lisplab)
#+nil (export '(mat new col row))
Modified: src/matrix/level1-generic.lisp
==============================================================================
--- src/matrix/level1-generic.lisp (original)
+++ src/matrix/level1-generic.lisp Wed May 20 16:05:54 2009
@@ -24,49 +24,4 @@
(in-package :lisplab)
-#-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 value (car dim) (cadr dim)))
-#+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))))
- (ecase (rank obj)
- (1 (dotimes (i (size obj))
- (setf (vref new i) (vref obj i))))
- (2 (dotimes (i (rows obj))
- (dotimes (j (cols obj))
- (setf (mref new i j) (mref obj i j))))))
- new)))
-
-#+todo-remove(defmethod copy (a)
- (typecase a
- (list (copy-list a))
- (sequence (copy-seq a))
- (t (let ((b (create a)))
- (dotimes (i (size a))
- (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))
- (i (second args))
- (j (third args)))
- `(let ((,a2 ,a))
- (dotimes (,i (rows ,a2))
- (dotimes (,j (cols ,a2))
- (let ((,x (mref ,a2 ,i ,j)))
- (setf (mref ,a2 ,i ,j)
- , at body))))
- ,a2)))
Modified: src/matrix/level1-interface.lisp
==============================================================================
--- src/matrix/level1-interface.lisp (original)
+++ src/matrix/level1-interface.lisp Wed May 20 16:05:54 2009
@@ -21,12 +21,11 @@
(in-package :lisplab)
(export '(*lisplab-print-size*
- vector? matrix?
- new mnew
- create mcreate
+ vector? matrix?
+ make-matrix-instance
ref mref vref
- dim element-type create
- size rank rows cols ))
+ dim element-type
+ size rank rows cols))
(defvar *lisplab-print-size* 10 "Suggested number of rows and columns printed to standard output. Not all matrices, such as ordinary lisp arrays, will care about the value.")
@@ -36,11 +35,8 @@
(defgeneric matrix? (x)
(:documentation "A matrix is a object whose elements are accesible with mref."))
-(defgeneric new (class dim &optional element-type value)
- (:documentation "Deprecated. Use mnew in stead. Creates a new matrix filled with numeric arguments."))
-
-(defgeneric mnew (class value rows &optional cols)
- (:documentation "General matrix constructor. Creates a new matrix filled with numeric arguments."))
+(defgeneric make-matrix-instance (type dim value)
+ (:documentation "Creates a new matrix instance"))
(defgeneric ref (matrix &rest subscripts)
(:documentation "A general accessor."))
@@ -68,18 +64,6 @@
(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 Wed May 20 16:05:54 2009
@@ -18,40 +18,9 @@
;;; 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)
-
-;;; This is OK, but could be optimzied!
-(defmacro w/mat (a args &body body)
- (let ((a2 (gensym))
- (x (first args))
- (i (second args))
- (j (third args)))
- `(let ((,a2 ,a))
- (dotimes (,i (rows ,a2))
- (dotimes (,j (cols ,a2))
- (let ((,x (mref ,a2 ,i ,j)))
- (setf (mref ,a2 ,i ,j)
- , at body))))
- ,a2)))
-
-
-;;; Generic methods and functions
-
-(defun convert-list-to-matrix (list type)
- (let* ((rows (length list))
- (cols (length (car list)))
- (m (mnew type 0 rows cols)))
- (fill-matrix-with-list m list)))
-
-(defun convert-matrix-to-matrix (m0 type)
- (let* ((rows (rows m0))
- (cols (cols m0))
- (m (mnew type 0 rows cols)))
- (dotimes (i rows)
- (dotimes (j cols)
- (setf (mref m i j) (mref m0 i j))))
- m))
+;;; TODO: clean up
+(in-package :lisplab)
(defmethod scalar? ((x matrix-base)) nil)
@@ -82,35 +51,20 @@
(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)))
-
+;;;; General cration
+(defmethod make-matrix-instance ((type symbol) dim value)
+ (make-instance type :rows (car dim) :cols (cadr dim) :value value))
+(defmethod make-matrix-instance ((type standard-class) dim value)
+ (make-instance type :rows (car dim) :cols (cadr dim) :value value))
+(defmethod make-matrix-instance ((description list) dim value)
+ (make-matrix-instance (find-matrix-class description) dim value))
+
;;; Spcialized for blas-dge
-(defmethod convert ((x cons) (type (eql 'matrix-dge)))
- (convert-list-to-matrix x type))
-
-(defmethod convert ((x matrix-base) (type (eql 'matrix-dge)))
- (convert-matrix-to-matrix x type))
-
-(defmethod mnew ((class (eql 'matrix-dge)) value rows &optional (cols 1))
- (make-matrix-instance class (list rows cols) value))
-
(defmethod mref ((matrix matrix-base-dge) row col)
(aref (the type-blas-store (matrix-store matrix))
(truly-the type-blas-idx (column-major-idx (truly-the type-blas-idx row)
@@ -132,18 +86,8 @@
(the double-float (coerce value 'double-float))))
-
;;; Spcialized for blas-zge
-(defmethod convert ((x cons) (type (eql 'matrix-zge)))
- (convert-list-to-matrix x type))
-
-(defmethod convert ((x matrix-base) (type (eql 'matrix-zge)))
- (convert-matrix-to-matrix x type))
-
-(defmethod mnew ((class (eql 'matrix-zge)) value rows &optional (cols 1))
- (make-matrix-instance class (list rows cols) 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 Wed May 20 16:05:54 2009
@@ -20,15 +20,6 @@
(in-package :lisplab)
-(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)))
- (make-instance class
- :value value
- :rows rows
- :cols cols)))
-
(defun fill-matrix-with-list (m x)
(let* ((rows (rows m))
(cols (cols m)))
Modified: src/matrix/level2-generic.lisp
==============================================================================
--- src/matrix/level2-generic.lisp (original)
+++ src/matrix/level2-generic.lisp Wed May 20 16:05:54 2009
@@ -21,6 +21,156 @@
(in-package :lisplab)
+;;; This is OK, but could be optimzied!
+(defmacro w/mat (a args &body body)
+ (let ((a2 (gensym))
+ (x (first args))
+ (i (second args))
+ (j (third args)))
+ `(let ((,a2 ,a))
+ (dotimes (,i (rows ,a2))
+ (dotimes (,j (cols ,a2))
+ (let ((,x (mref ,a2 ,i ,j)))
+ (setf (mref ,a2 ,i ,j)
+ , at body))))
+ ,a2)))
+
+#-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 value (car dim) (cadr dim)))
+
+#+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))))
+ (ecase (rank obj)
+ (1 (dotimes (i (size obj))
+ (setf (vref new i) (vref obj i))))
+ (2 (dotimes (i (rows obj))
+ (dotimes (j (cols obj))
+ (setf (mref new i j) (mref obj i j))))))
+ new)))
+
+#+todo-remove(defmethod copy (a)
+ (typecase a
+ (list (copy-list a))
+ (sequence (copy-seq a))
+ (t (let ((b (create a)))
+ (dotimes (i (size a))
+ (setf (vref b i) (vref a i)))
+ b))))
+
+#-todo-remove (defmethod create (a &optional value dim)
+ (mcreate a value dim))
+
+;; Helper function.
+(defun convert-list-to-matrix (list type)
+ (let* ((rows (length list))
+ (cols (length (car list)))
+ (m (make-matrix-instance type (list rows cols) 0)))
+ (fill-matrix-with-list m list)))
+
+;; Helper function.
+(defun convert-matrix-to-matrix (m0 type)
+ (let* ((rows (rows m0))
+ (cols (cols m0))
+ (m (make-matrix-instance type (dim m0) 0)))
+ (dotimes (i rows)
+ (dotimes (j cols)
+ (setf (mref m i j) (mref m0 i j))))
+ m))
+
+(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 based on descriptions
+ (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)))
+
+;;; TODO move to dge code
+
+#+todo-remove(defmethod convert ((x cons) (type (eql 'matrix-dge)))
+ (convert-list-to-matrix x type))
+
+#+todo-remove(defmethod convert ((x matrix-base) (type (eql 'matrix-dge)))
+ (convert-matrix-to-matrix x type))
+
+#+todo-remove(defmethod mnew ((class (eql 'matrix-dge)) value rows &optional (cols 1))
+ (make-matrix-instance class (list rows cols) value))
+
+;;; TODO move to zge code
+
+#+todo-remove(defmethod convert ((x cons) (type (eql 'matrix-zge)))
+ (convert-list-to-matrix x type))
+
+#+todo-remove(defmethod convert ((x matrix-base) (type (eql 'matrix-zge)))
+ (convert-matrix-to-matrix x type))
+
+#+todo-remove(defmethod mnew ((class (eql 'matrix-zge)) value rows &optional (cols 1))
+ (make-matrix-instance class (list rows cols) value))
+
+;; Should this be specialized to subclasses of matrix-base?
+;; This question also holds for other methds in this file
+(defmethod convert (x type)
+ (print "hei")
+ (let ((y (make-matrix-instance type (dim x) 0)))
+ ;; Note that I cannot use vref, since some matrix implmentations
+ ;; have different ordering.
+ (dotimes (i (rows x))
+ (dotimes (j (cols x))
+ (setf (mref y i j) (mref x i j))))
+ y))
+
+(defmethod convert ((x cons) type)
+ ;; TODO some better way ... some more general guessing routine
+ ;; like guess-best-element-type
+ (if (consp (car x))
+ (let* ((cols (length (car x)))
+ (rows (length x))
+ (m (make-matrix-instance type (list rows cols) 0)))
+ (do ((xx x (cdr xx))
+ (i 0 (1+ i)))
+ ((= i rows))
+ (do ((yy (car xx) (cdr yy))
+ (j 0 (1+ j)))
+ ((= j cols))
+ (setf (mref m i j) (car yy))))
+ m)
+ ;; else make a row vector
+ (convert (list x) type)))
+
+(defmethod mmap (type f a &rest args)
+ (let ((b (new type (dim a) )))
+ (cond ((not args)
+ (dotimes (i (size a))
+ (setf (vref b i) (funcall f (vref a i)))))
+ ((not (cdr args))
+ (let ((c (car args)))
+ (dotimes (i (size a))
+ (setf (vref b i) (funcall f (vref a i) (vref c i))))))
+ (t (dotimes (i (size a))
+ (setf (vref b i) (apply f (vref a i)
+ (mapcar (lambda (x)
+ (vref x i))
+ args))))))
+ b))
+
+(defmethod .map (f a &rest args)
+ (apply #'mmap (class-name (class-of a)) f a args))
+
+
+
+
+
+
+
(defmethod square-matrix? (x)
(and (matrix? x) (= (rows x) (cols x))))
@@ -76,44 +226,10 @@
(setf (vref a i) val))
val)
-(defmethod mmap (type f a &rest args)
- (let ((b (new type (dim a) )))
- (cond ((not args)
- (dotimes (i (size a))
- (setf (vref b i) (funcall f (vref a i)))))
- ((not (cdr args))
- (let ((c (car args)))
- (dotimes (i (size a))
- (setf (vref b i) (funcall f (vref a i) (vref c i))))))
- (t (dotimes (i (size a))
- (setf (vref b i) (apply f (vref a i)
- (mapcar (lambda (x)
- (vref x i))
- args))))))
- b))
-
-(defmethod .map (f a &rest args)
- (apply #'mmap (class-name (class-of a)) f a args))
-(defmethod convert ((x cons) type)
- ;; TODO some better way ... some more general guessing routine
- ;; like guess-best-element-type
- (if (consp (car x))
- (let* ((cols (length (car x)))
- (rows (length x))
- (m (new type (list rows cols))))
- (do ((xx x (cdr xx))
- (i 0 (1+ i)))
- ((= i rows))
- (do ((yy (car xx) (cdr yy))
- (j 0 (1+ j)))
- ((= j cols))
- (setf (mref m i j) (car yy))))
- m)
- ;; else make a row vector
- (convert (list x) type)))
(defmethod circ-shift (A shift)
+ ;; TODO move to level3
(let ((B (create A))
(rows (rows A))
(cols (cols A))
@@ -126,6 +242,7 @@
B))
(defmethod pad-shift (A shift &optional (value 0))
+ ;; TODO move to level3
(let ((B (create A value))
(rows (rows A))
(cols (cols A))
Modified: src/matrix/level2-interface.lisp
==============================================================================
--- src/matrix/level2-interface.lisp (original)
+++ src/matrix/level2-interface.lisp Wed May 20 16:05:54 2009
@@ -19,7 +19,10 @@
(in-package :lisplab)
-(export '(square-matrix?
+(export '(
+ new mnew
+ create mcreate
+ square-matrix?
diag
.map mmap fill!
dlmwrite dlmread
@@ -37,6 +40,25 @@
circ-shift
pad-shift))
+
+(defgeneric new (class dim &optional element-type value)
+ (:documentation "Deprecated. Use mnew in stead. Creates a new matrix filled with numeric arguments."))
+
+(defgeneric mnew (class value rows &optional cols)
+ (:documentation "General matrix constructor. Creates a new matrix filled with numeric arguments."))
+
+(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 square-matrix? (x)
(:documentation "True when the matrix is square, obviously."))
More information about the lisplab-cvs
mailing list