[lisplab-cvs] r109 - src/matrix
Jørn Inge Vestgården
jivestgarden at common-lisp.net
Sun Nov 8 11:30:22 UTC 2009
Author: jivestgarden
Date: Sun Nov 8 06:30:22 2009
New Revision: 109
Log:
refactored structure
Added:
src/matrix/level1-dge.lisp
src/matrix/level1-funmat.lisp
src/matrix/level1-ge.lisp
src/matrix/level1-zge.lisp
Modified:
lisplab.asd
src/matrix/level1-classes.lisp
src/matrix/level1-matrix.lisp
Modified: lisplab.asd
==============================================================================
--- lisplab.asd (original)
+++ lisplab.asd Sun Nov 8 06:30:22 2009
@@ -63,16 +63,22 @@
(
(:file "level1-interface")
- ;; These three should be independent of the rest
- (:file "level1-util")
- (:file "store-operators")
- (:file "store-ordinary-functions")
+ ;; The three double-float store utility files should
+ ;; depend on the CL package only
+ (:file "level1-util")
+ (:file "store-operators")
+ (:file "store-ordinary-functions")
(:file "level1-classes")
(:file "level1-constructors")
(:file "level1-matrix")
+
+ (:file "level1-ge")
+ (:file "level1-dge")
+ (:file "level1-zge")
+ (:file "level1-funmat")
(:file "level1-sparse")
- (:file "level1-array")
+ (:file "level1-array")
(:file "level2-interface")
(:file "level2-constructors")
Modified: src/matrix/level1-classes.lisp
==============================================================================
--- src/matrix/level1-classes.lisp (original)
+++ src/matrix/level1-classes.lisp Sun Nov 8 06:30:22 2009
@@ -101,78 +101,6 @@
;;; The actual classes meant for instantiation
-;;;; General matrices with unspecified element types
-
-(defclass matrix-ge
- (matrix-structure-general matrix-element-base matrix-implementation-lisp)
- ((matrix-store
- :initarg :store
- :initform nil
- :reader matrix-store
- :type (simple-array t (*))))
- (:documentation "A full matrix (rows x cols) with unspecified matrix element types."))
-
-(defmethod initialize-instance :after ((m matrix-ge) &key (value 0))
- (with-slots (rows cols size matrix-store) m
- (setf size (* rows cols))
- (unless matrix-store
- (setf matrix-store (make-array size :initial-element value)))))
-
-;;; Double float general matrices
-
-(defclass matrix-base-dge
- (matrix-structure-general matrix-element-double-float matrix-implementation-base)
- ((matrix-store
- :initarg :store
- :initform nil
- :reader matrix-store
- :type type-blas-store)))
-
-(defmethod initialize-instance :after ((m matrix-base-dge) &key (value 0))
- (with-slots (rows cols size matrix-store) m
- (setf size (* rows cols))
- (unless matrix-store
- (setf matrix-store (allocate-real-store size value)))))
-
-(defclass matrix-lisp-dge (matrix-implementation-lisp matrix-base-dge) ()
- (:documentation "A full matrix (rows x cols) with double float elements.
-Executes in lisp only."))
-
-(defclass matrix-blas-dge (matrix-implementation-blas matrix-lisp-dge) ()
- (:documentation "A full matrix (rows x cols) with double float elements.
-Executes in alien blas/lapack only."))
-
-(defclass matrix-dge (matrix-blas-dge) ()
- (:documentation "A full matrix (rows x cols) with double float matrix elements.
-Executes first in alien blas/lapack if possible. If not it executes in lisp."))
-
-;;; Complex double float general matrices
-
-(defclass matrix-base-zge
- (matrix-structure-general matrix-element-complex-double-float matrix-implementation-base)
- ((matrix-store
- :initarg :store
- :initform nil
- :accessor matrix-store
- :type type-blas-store)))
-
-(defmethod initialize-instance :after ((m matrix-base-zge) &key (value 0))
- (with-slots (rows cols size matrix-store) m
- (setf size (* rows cols))
- (unless matrix-store
- (setf matrix-store (allocate-complex-store size value)))))
-
-(defclass matrix-lisp-zge (matrix-implementation-lisp matrix-base-zge) ()
- (:documentation "A full matrix (rows x cols) with complex double float elements.
-Executes in lisp only."))
-
-(defclass matrix-blas-zge (matrix-implementation-blas matrix-lisp-zge) ()
- (:documentation "A full matrix (rows x cols) with complex double float elements.
-Executes in alien blas/lapack only."))
-
-(defclass matrix-zge (matrix-blas-zge) ()
- (:documentation "A full matrix (rows x cols) with complex double float matrix elements.
-Executes first in alien blas/lapack if possible. If not it executes in lisp."))
;;; Double float diagonal matrices
@@ -190,35 +118,6 @@
(matrix-structure-diagonal matrix-element-complex-double-float matrix-implementation-base)
())
-;;; Function matrices (matrices without a store)
-
-(defclass function-matrix
- (matrix-structure-general matrix-element-base matrix-implementation-base)
- ((mref
- :initarg :mref
- :initform (constantly 0)
- :accessor function-matrix-mref
- :type function)
- (set-mref
- :initarg :set-mref
- :initform (constantly nil)
- :accessor function-matrix-set-mref
- :type function)
- (vref
- :initarg :vref
- :initform (constantly 0)
- :accessor function-matrix-vref
- :type function)
- (set-vref
- :initarg :set-vref
- :initform (constantly nil)
- :accessor function-matrix-set-vref
- :type function))
- (:documentation "Matrix without a store."))
-
-(defmethod initialize-instance :after ((m function-matrix) &key)
- (with-slots (rows cols size matrix-store) m
- (setf size (* rows cols))))
Added: src/matrix/level1-dge.lisp
==============================================================================
--- (empty file)
+++ src/matrix/level1-dge.lisp Sun Nov 8 06:30:22 2009
@@ -0,0 +1,74 @@
+;;; Lisplab, level1-dge.lisp
+;;; General, double-float matrices
+
+;;; Copyright (C) 2009 Joern Inge Vestgaarden
+;;;
+;;; 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)
+
+;;; Double float general classes
+
+(defclass matrix-base-dge
+ (matrix-structure-general matrix-element-double-float matrix-implementation-base)
+ ((matrix-store
+ :initarg :store
+ :initform nil
+ :reader matrix-store
+ :type type-blas-store)))
+
+(defmethod initialize-instance :after ((m matrix-base-dge) &key (value 0))
+ (with-slots (rows cols size matrix-store) m
+ (setf size (* rows cols))
+ (unless matrix-store
+ (setf matrix-store (allocate-real-store size value)))))
+
+(defclass matrix-lisp-dge (matrix-implementation-lisp matrix-base-dge) ()
+ (:documentation "A full matrix (rows x cols) with double float elements.
+Executes in lisp only."))
+
+(defclass matrix-blas-dge (matrix-implementation-blas matrix-lisp-dge) ()
+ (:documentation "A full matrix (rows x cols) with double float elements.
+Executes in alien blas/lapack only."))
+
+(defclass matrix-dge (matrix-blas-dge) ()
+ (:documentation "A full matrix (rows x cols) with double float matrix elements.
+Executes first in alien blas/lapack if possible. If not it executes in lisp."))
+
+
+;;; All leve1 methods spcialized for dge
+
+(defmethod mref ((matrix matrix-base-dge) row col)
+ (ref-blas-real-store (slot-value matrix 'matrix-store) row col (slot-value matrix 'rows)))
+
+(defmethod (setf mref) (value (matrix matrix-base-dge) row col)
+ (let ((val2 (coerce value 'double-float)))
+ (declare (type double-float val2))
+ (setf (ref-blas-real-store (slot-value matrix 'matrix-store)
+ row col (slot-value matrix 'rows))
+ val2)
+ val2))
+
+(defmethod vref ((matrix matrix-base-dge) idx)
+ (aref (the type-blas-store (slot-value matrix 'matrix-store)) idx))
+
+(defmethod (setf vref) (value (matrix matrix-base-dge) idx)
+ (let ((val2 (coerce value 'double-float)))
+ (declare (type double-float val2))
+ (setf (aref (the type-blas-store (slot-value matrix 'matrix-store)) idx)
+ val2)
+ val2))
+
+
Added: src/matrix/level1-funmat.lisp
==============================================================================
--- (empty file)
+++ src/matrix/level1-funmat.lisp Sun Nov 8 06:30:22 2009
@@ -0,0 +1,64 @@
+;;; Lisplab, level1-dge.lisp
+;;; General, storeless matrices
+
+;;; Copyright (C) 2009 Joern Inge Vestgaarden
+;;;
+;;; 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)
+
+;;; Function matrices (matrices without a store)
+
+(defclass function-matrix
+ (matrix-structure-general matrix-element-base matrix-implementation-base)
+ ((mref
+ :initarg :mref
+ :initform (constantly 0)
+ :accessor function-matrix-mref
+ :type function)
+ (set-mref
+ :initarg :set-mref
+ :initform (constantly nil)
+ :accessor function-matrix-set-mref
+ :type function)
+ (vref
+ :initarg :vref
+ :initform (constantly 0)
+ :accessor function-matrix-vref
+ :type function)
+ (set-vref
+ :initarg :set-vref
+ :initform (constantly nil)
+ :accessor function-matrix-set-vref
+ :type function))
+ (:documentation "Matrix without a store."))
+
+(defmethod initialize-instance :after ((m function-matrix) &key)
+ (with-slots (rows cols size matrix-store) m
+ (setf size (* rows cols))))
+
+;;; Level1 methods specialized for the function matrix
+
+(defmethod mref ((f function-matrix) row col)
+ (funcall (function-matrix-mref f) f row col))
+
+(defmethod (setf mref) (value (f function-matrix) row col)
+ (funcall (function-matrix-set-mref f) value f row col))
+
+(defmethod vref ((f function-matrix) idx)
+ (funcall (function-matrix-vref f) f idx))
+
+(defmethod (setf vref) (value (f function-matrix) idx)
+ (funcall (function-matrix-set-vref f) value f idx))
Added: src/matrix/level1-ge.lisp
==============================================================================
--- (empty file)
+++ src/matrix/level1-ge.lisp Sun Nov 8 06:30:22 2009
@@ -0,0 +1,55 @@
+;;; Lisplab, level1-dge.lisp
+;;; General, untyped matrices
+
+;;; Copyright (C) 2009 Joern Inge Vestgaarden
+;;;
+;;; 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)
+
+;;;; General matrices with unspecified element types
+
+(defclass matrix-ge
+ (matrix-structure-general matrix-element-base matrix-implementation-lisp)
+ ((matrix-store
+ :initarg :store
+ :initform nil
+ :reader matrix-store
+ :type (simple-array t (*))))
+ (:documentation "A full matrix (rows x cols) with unspecified matrix element types."))
+
+(defmethod initialize-instance :after ((m matrix-ge) &key (value 0))
+ (with-slots (rows cols size matrix-store) m
+ (setf size (* rows cols))
+ (unless matrix-store
+ (setf matrix-store (make-array size :initial-element value)))))
+
+;;; Level methods specialized for untyped, general matrices
+
+(defmethod mref ((matrix matrix-ge) row col)
+ (aref (slot-value matrix 'matrix-store)
+ (column-major-idx row col (slot-value matrix 'rows))))
+
+(defmethod (setf mref) (value (matrix matrix-ge) row col)
+ (setf (aref (slot-value matrix 'matrix-store)
+ (column-major-idx row col (slot-value matrix 'rows)))
+ value))
+
+(defmethod vref ((matrix matrix-ge) idx)
+ (aref (slot-value matrix 'matrix-store) idx))
+
+(defmethod (setf vref) (value (matrix matrix-ge) idx)
+ (setf (aref (slot-value matrix 'matrix-store) idx)
+ value))
Modified: src/matrix/level1-matrix.lisp
==============================================================================
--- src/matrix/level1-matrix.lisp (original)
+++ src/matrix/level1-matrix.lisp Sun Nov 8 06:30:22 2009
@@ -40,20 +40,22 @@
(list (rows matrix) (cols matrix))))
(defmethod print-object ((matrix matrix-base) stream)
+ "Prints matrix as an unreadable object. The number of printed
+rows and columns is limited by *lisplab-print-size*."
(print-unreadable-object (matrix stream :type t :identity t)
(let ((rows (min (rows matrix) *lisplab-print-size*))
(cols (min (cols matrix) *lisplab-print-size*)))
- (format stream " ~Ax~A~&" (rows matrix) (cols matrix))
+ (format stream " ~ax~a~&" (rows matrix) (cols matrix))
(dotimes (i rows)
(dotimes (j cols)
- (format stream "~S " (mref matrix i j)))
+ (format stream "~a " (mref matrix i j)))
(when (< cols (cols matrix))
(format stream "..."))
(princ #\Newline stream))
(when (< rows (rows matrix))
(format stream "...~%")))))
-;;;; General cration
+;;;; Matrix constructors
(defmethod make-matrix-instance ((type symbol) dim value)
(make-instance type :rows (car dim) :cols (cadr dim) :value value))
@@ -64,82 +66,6 @@
(defmethod make-matrix-instance ((description list) dim value)
(make-matrix-instance (find-matrix-class description) dim value))
-;;; The general matrix
-(defmethod mref ((matrix matrix-ge) row col)
- (aref (slot-value matrix 'matrix-store)
- (column-major-idx row col (slot-value matrix 'rows))))
-
-(defmethod (setf mref) (value (matrix matrix-ge) row col)
- (setf (aref (slot-value matrix 'matrix-store)
- (column-major-idx row col (slot-value matrix 'rows)))
- value))
-
-(defmethod vref ((matrix matrix-ge) idx)
- (aref (slot-value matrix 'matrix-store) idx))
-
-(defmethod (setf vref) (value (matrix matrix-ge) idx)
- (setf (aref (slot-value matrix 'matrix-store) idx)
- value))
-
-;;; Spcialized for blas-dge
-
-(defmethod mref ((matrix matrix-base-dge) row col)
- (ref-blas-real-store (slot-value matrix 'matrix-store) row col (slot-value matrix 'rows)))
-
-(defmethod (setf mref) (value (matrix matrix-base-dge) row col)
- (let ((val2 (coerce value 'double-float)))
- (declare (type double-float val2))
- (setf (ref-blas-real-store (slot-value matrix 'matrix-store)
- row col (slot-value matrix 'rows))
- val2)
- val2))
-
-(defmethod vref ((matrix matrix-base-dge) idx)
- (aref (the type-blas-store (slot-value matrix 'matrix-store)) idx))
-
-(defmethod (setf vref) (value (matrix matrix-base-dge) idx)
- (let ((val2 (coerce value 'double-float)))
- (declare (type double-float val2))
- (setf (aref (the type-blas-store (slot-value matrix 'matrix-store)) idx)
- val2)
- val2))
-
-;;; Spcialized for blas-zge
-
-(defmethod mref ((matrix matrix-base-zge) row col)
- (ref-blas-complex-store (slot-value matrix 'matrix-store)
- row col (slot-value matrix 'rows)))
-
-(defmethod (setf mref) (value (matrix matrix-base-zge) row col)
- (let ((val2 (coerce value '(complex double-float))))
- (declare (type (complex double-float) val2))
- (setf (ref-blas-complex-store (slot-value matrix 'matrix-store)
- row col (slot-value matrix 'rows))
- val2)
- val2))
-
-(defmethod vref ((matrix matrix-base-zge) i)
- (ref-blas-complex-store (slot-value matrix 'matrix-store) i 0 1))
-
-(defmethod (setf vref) (value (matrix matrix-base-zge) i)
- (let ((val2 (coerce value '(complex double-float))))
- (declare (type (complex double-float) val2))
- (setf (ref-blas-complex-store (slot-value matrix 'matrix-store) i 0 1)
- val2)
- val2))
-
-;;; Function matrix
-
-(defmethod mref ((f function-matrix) row col)
- (funcall (function-matrix-mref f) f row col))
-(defmethod (setf mref) (value (f function-matrix) row col)
- (funcall (function-matrix-set-mref f) value f row col))
-
-(defmethod vref ((f function-matrix) idx)
- (funcall (function-matrix-vref f) f idx))
-
-(defmethod (setf vref) (value (f function-matrix) idx)
- (funcall (function-matrix-set-vref f) value f idx))
Added: src/matrix/level1-zge.lisp
==============================================================================
--- (empty file)
+++ src/matrix/level1-zge.lisp Sun Nov 8 06:30:22 2009
@@ -0,0 +1,74 @@
+;;; Lisplab, level1-zge.lisp
+;;; General, complex double-float matrices
+
+;;; Copyright (C) 2009 Joern Inge Vestgaarden
+;;;
+;;; 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)
+
+;;; Complex double float general matrices
+
+(defclass matrix-base-zge
+ (matrix-structure-general matrix-element-complex-double-float matrix-implementation-base)
+ ((matrix-store
+ :initarg :store
+ :initform nil
+ :accessor matrix-store
+ :type type-blas-store)))
+
+(defmethod initialize-instance :after ((m matrix-base-zge) &key (value 0))
+ (with-slots (rows cols size matrix-store) m
+ (setf size (* rows cols))
+ (unless matrix-store
+ (setf matrix-store (allocate-complex-store size value)))))
+
+(defclass matrix-lisp-zge (matrix-implementation-lisp matrix-base-zge) ()
+ (:documentation "A full matrix (rows x cols) with complex double float elements.
+Executes in lisp only."))
+
+(defclass matrix-blas-zge (matrix-implementation-blas matrix-lisp-zge) ()
+ (:documentation "A full matrix (rows x cols) with complex double float elements.
+Executes in alien blas/lapack only."))
+
+(defclass matrix-zge (matrix-blas-zge) ()
+ (:documentation "A full matrix (rows x cols) with complex double float matrix elements.
+Executes first in alien blas/lapack if possible. If not it executes in lisp."))
+
+
+;;; Level1 methods specialized for zge
+
+(defmethod mref ((matrix matrix-base-zge) row col)
+ (ref-blas-complex-store (slot-value matrix 'matrix-store)
+ row col (slot-value matrix 'rows)))
+
+(defmethod (setf mref) (value (matrix matrix-base-zge) row col)
+ (let ((val2 (coerce value '(complex double-float))))
+ (declare (type (complex double-float) val2))
+ (setf (ref-blas-complex-store (slot-value matrix 'matrix-store)
+ row col (slot-value matrix 'rows))
+ val2)
+ val2))
+
+(defmethod vref ((matrix matrix-base-zge) i)
+ (ref-blas-complex-store (slot-value matrix 'matrix-store) i 0 1))
+
+(defmethod (setf vref) (value (matrix matrix-base-zge) i)
+ (let ((val2 (coerce value '(complex double-float))))
+ (declare (type (complex double-float) val2))
+ (setf (ref-blas-complex-store (slot-value matrix 'matrix-store) i 0 1)
+ val2)
+ val2))
+
More information about the lisplab-cvs
mailing list