[lisplab-cvs] r110 - src/matrix
Jørn Inge Vestgården
jivestgarden at common-lisp.net
Sun Nov 8 16:30:10 UTC 2009
Author: jivestgarden
Date: Sun Nov 8 11:30:09 2009
New Revision: 110
Log:
diagnoal and tridigonal matrices
Added:
src/matrix/level1-ddiag.lisp
src/matrix/level1-dgt.lisp
Modified:
lisplab.asd
src/matrix/level1-classes.lisp
src/matrix/level1-constructors.lisp
src/matrix/level1-dge.lisp
src/matrix/level1-ge.lisp
src/matrix/level1-interface.lisp
src/matrix/level1-matrix.lisp
src/matrix/level1-zge.lisp
src/matrix/level2-constructors.lisp
Modified: lisplab.asd
==============================================================================
--- lisplab.asd (original)
+++ lisplab.asd Sun Nov 8 11:30:09 2009
@@ -76,6 +76,8 @@
(:file "level1-ge")
(:file "level1-dge")
(:file "level1-zge")
+ (:file "level1-ddiag")
+ (:file "level1-dgt")
(:file "level1-funmat")
(:file "level1-sparse")
(:file "level1-array")
Modified: src/matrix/level1-classes.lisp
==============================================================================
--- src/matrix/level1-classes.lisp (original)
+++ src/matrix/level1-classes.lisp Sun Nov 8 11:30:09 2009
@@ -1,5 +1,5 @@
;;; Lisplab, level1-classes.lisp
-;;; Level1, matrix classes
+;;; Level1, abstract matrix classes
;;; Copyright (C) 2009 Joern Inge Vestgaarden
;;;
@@ -23,8 +23,6 @@
(in-package :lisplab)
-(declaim (inline matrix-store))
-
(defclass matrix-base () ())
;;; The matrix element tells the element type of the matrix
@@ -92,13 +90,16 @@
:reader size
:type type-blas-idx)))
-(defclass matrix-structure-diagonal (matrix-structure-base)
- ((size
- :initarg :size
+(defclass matrix-structure-square (matrix-structure-base)
+ ((rowcols
+ :initarg :rowcols
:initform 0
- :accessor size
- :type type-blas-idx)))
+ :reader rowcols
+ :type type-blas-idx)))
+
+
+#| REMOVE
;;; The actual classes meant for instantiation
@@ -118,9 +119,4 @@
(matrix-structure-diagonal matrix-element-complex-double-float matrix-implementation-base)
())
-
-
-
-
-
-
+|#
\ No newline at end of file
Modified: src/matrix/level1-constructors.lisp
==============================================================================
--- src/matrix/level1-constructors.lisp (original)
+++ src/matrix/level1-constructors.lisp Sun Nov 8 11:30:09 2009
@@ -1,5 +1,5 @@
;;; Lisplab, level1-constructors.lisp
-;;;
+;;; A symbolic naming scheme for matrix construction.
;;; Copyright (C) 2009 Joern Inge Vestgaarden
;;;
@@ -22,6 +22,19 @@
(in-package :lisplab)
+;;;; Matrix constructors
+
+(defmethod make-matrix-instance ((type standard-class) dim value)
+ (make-instance type :dim dim :value value))
+
+(defmethod make-matrix-instance ((type symbol) dim value)
+ (make-matrix-instance (find-class type) dim value))
+
+(defmethod make-matrix-instance ((description list) dim value)
+ (make-matrix-instance (find-matrix-class description) dim value))
+
+
+
;; A scheme for matrix creations
(defvar *matrix-class-to-description* (make-hash-table))
@@ -39,14 +52,14 @@
(let* ((entry (gethash description
*matrix-description-to-class*)))
(unless entry
- (error "No matrix of structure ~A." description))
+ (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))
+ (error "No matrix description of class ~a." class))
entry))
(defun create-matrix-description (obj &key et s i)
@@ -58,21 +71,6 @@
(if et et (first d0))
(if s s (second d0))
(if i i (third d0)))))
-
-;;; Adding all the matrix descriptions
-
-(add-matrix-class 'matrix-base-ge :any :ge :base)
-(add-matrix-class 'matrix-ge :any :ge :any)
-(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
Added: src/matrix/level1-ddiag.lisp
==============================================================================
--- (empty file)
+++ src/matrix/level1-ddiag.lisp Sun Nov 8 11:30:09 2009
@@ -0,0 +1,74 @@
+;;; Lisplab, level1-dge.lisp
+;;; Diagonal 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.
+
+;;; TODO: bidiagnonal matrices
+
+;;; Note: not optimzied, but I see no good reason to optimzized them either.
+
+(in-package :lisplab)
+
+(defclass matrix-base-ddi
+ (matrix-structure-square matrix-element-double-float matrix-implementation-base)
+ ((diagonal-store
+ :initarg :diagonal-store
+ :initform nil
+ :type type-blas-store)))
+
+(defmethod initialize-instance :after ((m matrix-base-ddi) &key dim (value 0))
+ (with-slots (rowcols diagonal-store) m
+ (setf rowcols dim)
+ (unless diagonal-store
+ (setf diagonal-store (allocate-real-store rowcols value)))))
+
+(defclass matrix-lisp-ddi (matrix-implementation-lisp matrix-base-ddi) ())
+
+(defclass matrix-blas-ddi (matrix-implementation-blas matrix-lisp-ddi) ())
+
+(defclass matrix-ddi (matrix-blas-ddi) ())
+
+;;; Add classes to the generic matrix creation scheme
+(add-matrix-class 'matrix-base-ddi :d :di :base)
+(add-matrix-class 'matrix-lisp-ddi :d :di :lisp)
+(add-matrix-class 'matrix-blas-ddi :d :di :blas)
+(add-matrix-class 'matrix-ddi :d :di :any)
+
+;;; Methods spezilied for the diagnoal matrices
+
+(defmethod mref ((matrix matrix-base-ddi) row col)
+ (if (= row col)
+ (aref (slot-value matrix 'diagonal-store) row)
+ 0.0))
+
+(defmethod (setf mref) (value (matrix matrix-base-ddi) row col)
+ (if (= row col)
+ (setf (aref (slot-value matrix 'diagonal-store) row)
+ (coerce value 'double-float))
+ (warn "Array out of bonds for diagonal matrix. Ignored.")))
+
+(defmethod size ((matrix matrix-base-ddi))
+ (slot-value matrix 'rowcols))
+
+(defmethod vref ((matrix matrix-base-ddi) idx)
+ (aref (slot-value matrix 'diagonal-store) idx))
+
+(defmethod (setf vref) (value (matrix matrix-base-dge) idx)
+ (let ((val2 (coerce value 'double-float)))
+ (setf (aref (the type-blas-store (slot-value matrix 'matrix-store)) idx)
+ val2)
+ val2))
Modified: src/matrix/level1-dge.lisp
==============================================================================
--- src/matrix/level1-dge.lisp (original)
+++ src/matrix/level1-dge.lisp Sun Nov 8 11:30:09 2009
@@ -29,9 +29,11 @@
:reader matrix-store
:type type-blas-store)))
-(defmethod initialize-instance :after ((m matrix-base-dge) &key (value 0))
+(defmethod initialize-instance :after ((m matrix-base-dge) &key dim (value 0))
(with-slots (rows cols size matrix-store) m
- (setf size (* rows cols))
+ (setf rows (car dim)
+ cols (cadr dim)
+ size (* rows cols))
(unless matrix-store
(setf matrix-store (allocate-real-store size value)))))
@@ -47,6 +49,11 @@
(: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."))
+;;; Add classes to the generic matrix creation scheme
+(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)
;;; All leve1 methods spcialized for dge
Added: src/matrix/level1-dgt.lisp
==============================================================================
--- (empty file)
+++ src/matrix/level1-dgt.lisp Sun Nov 8 11:30:09 2009
@@ -0,0 +1,117 @@
+;;; Lisplab, level1-dgt.lisp
+;;; Tridiagonal 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.
+
+;;; Note: not optimzied, but I see no good reason to optimzized them either.
+
+(in-package :lisplab)
+
+;;; Tridiagonal matrices
+
+(defclass matrix-base-dgt
+ (matrix-structure-square matrix-element-double-float matrix-implementation-base)
+ ((size
+ :initarg :size
+ :type type-blas-idx)
+ (diagonal-store
+ :initarg :diagonal-store
+ :initform nil
+ :type type-blas-store)
+ (subdiagonal-store
+ :initarg :subdiagonal-store
+ :initform nil
+ :type type-blas-store)
+ (superdiagonal-store
+ :initarg :superdiagonal-store
+ :initform nil
+ :type type-blas-store)))
+
+(defmethod initialize-instance :after ((m matrix-base-dgt) &key dim (value 0))
+ (with-slots (rowcols size diagonal-store subdiagonal-store superdiagonal-store) m
+ (setf rowcols dim
+ size (- (* 3 rowcols) 2))
+ (unless diagonal-store
+ (setf diagonal-store (allocate-real-store rowcols value)))
+ (unless subdiagonal-store
+ (setf subdiagonal-store (allocate-real-store (1- rowcols) value)))
+ (unless superdiagonal-store
+ (setf superdiagonal-store (allocate-real-store (1- rowcols) value)))))
+
+(defclass matrix-lisp-dgt (matrix-implementation-lisp matrix-base-dgt) ())
+
+(defclass matrix-blas-dgt (matrix-implementation-blas matrix-lisp-dgt) ())
+
+(defclass matrix-dgt (matrix-blas-dgt) ())
+
+;;; Add classes to the generic matrix creation scheme
+(add-matrix-class 'matrix-base-dgt :d :gt :base)
+(add-matrix-class 'matrix-lisp-dgt :d :gt :lisp)
+(add-matrix-class 'matrix-blas-dgt :d :gt :blas)
+(add-matrix-class 'matrix-dgt :d :gt :any)
+
+;;; Methods spezilied for the tridiagnoal matrices
+
+(defmethod mref ((matrix matrix-base-dgt) row col)
+ (cond ((= row col)
+ (aref (slot-value matrix 'diagonal-store) row))
+ ((= (1- row) col)
+ (aref (slot-value matrix 'subdiagonal-store) col))
+ ((= (1+ row) col) 8
+ (aref (slot-value matrix 'superdiagonal-store) row))
+ (t 0.0)))
+
+(defmethod (setf mref) (value (matrix matrix-base-dgt) row col)
+ (let ((val2 (coerce value 'double-float)))
+ (cond ((= row col)
+ (setf (aref (slot-value matrix 'diagonal-store) row)
+ val2))
+ ((= (1- row) col)
+ (setf (aref (slot-value matrix 'subdiagonal-store) col)
+ val2))
+ ((= (1+ row) col)
+ (setf (aref (slot-value matrix 'superdiagonal-store) row)
+ val2))
+ (t
+ (warn "Array out of bonds for tridiagonal matrix. Ignored.")))))
+
+(defmethod vref ((matrix matrix-base-dgt) idx)
+ (let ((len (slot-value matrix 'rowcols)))
+ (cond ((< idx len)
+ (aref (slot-value matrix 'diagonal-store) idx))
+ ((< idx (- (* 2 len) 1))
+ (aref (slot-value matrix 'superdiagonal-store) (- idx len)))
+ ((< idx (slot-value matrix 'size))
+ (aref (slot-value matrix 'subdiagonal-store) (- idx (- (* 2 len) 1))))
+ (t
+ (warn "Array out of bonds for tridiagonal matrix. Ignored.")))))
+
+(defmethod (setf vref) (value (matrix matrix-base-dge) idx)
+ (let ((val2 (coerce value 'double-float))
+ (len (slot-value matrix 'rowcols)))
+ (cond ((< idx len)
+ (setf (aref (slot-value matrix 'diagonal-store) idx)
+ val2))
+ ((< idx (- (* 2 len) 1))
+ (setf (aref (slot-value matrix 'superdiagonal-store) (- idx len))
+ val2))
+ ((< idx (- (* 3 len) 2))
+ (setf (aref (slot-value matrix 'subdiagonal-store) (- idx (- (* 2 len) 1)))
+ val2))
+ (t
+ (warn "Array out of bonds for tridiagonal matrix. Ignored.")))
+ val2))
Modified: src/matrix/level1-ge.lisp
==============================================================================
--- src/matrix/level1-ge.lisp (original)
+++ src/matrix/level1-ge.lisp Sun Nov 8 11:30:09 2009
@@ -30,9 +30,15 @@
: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))
+;;; Add class to the generic matrix creation scheme
+(add-matrix-class 'matrix-base-ge :any :ge :base)
+(add-matrix-class 'matrix-ge :any :ge :any)
+
+(defmethod initialize-instance :after ((m matrix-ge) &key dim (value 0))
(with-slots (rows cols size matrix-store) m
- (setf size (* rows cols))
+ (setf rows (car dim)
+ cols (cadr dim)
+ size (* rows cols))
(unless matrix-store
(setf matrix-store (make-array size :initial-element value)))))
Modified: src/matrix/level1-interface.lisp
==============================================================================
--- src/matrix/level1-interface.lisp (original)
+++ src/matrix/level1-interface.lisp Sun Nov 8 11:30:09 2009
@@ -72,3 +72,11 @@
(defgeneric (setf cols) (value matrix))
+;;; Integral routines for access to matrix store
+
+(declaim (inline matrix-store))
+
+(defgeneric matrix-store (x)
+ (:documentation "Returns the store of the matrix"))
+
+
Modified: src/matrix/level1-matrix.lisp
==============================================================================
--- src/matrix/level1-matrix.lisp (original)
+++ src/matrix/level1-matrix.lisp Sun Nov 8 11:30:09 2009
@@ -55,16 +55,13 @@
(when (< rows (rows matrix))
(format stream "...~%")))))
-;;;; Matrix constructors
+;;; Spezialized for square matrices
-(defmethod make-matrix-instance ((type symbol) dim value)
- (make-instance type :rows (car dim) :cols (cadr dim) :value value))
+(defmethod rows ((matrix matrix-structure-square))
+ (slot-value matrix 'rowcols))
-(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))
+(defmethod cols ((matrix matrix-structure-square))
+ (slot-value matrix 'rowcols))
Modified: src/matrix/level1-zge.lisp
==============================================================================
--- src/matrix/level1-zge.lisp (original)
+++ src/matrix/level1-zge.lisp Sun Nov 8 11:30:09 2009
@@ -29,9 +29,11 @@
:accessor matrix-store
:type type-blas-store)))
-(defmethod initialize-instance :after ((m matrix-base-zge) &key (value 0))
+(defmethod initialize-instance :after ((m matrix-base-zge) &key dim (value 0))
(with-slots (rows cols size matrix-store) m
- (setf size (* rows cols))
+ (setf rows (car dim)
+ cols (cadr dim)
+ size (* rows cols))
(unless matrix-store
(setf matrix-store (allocate-complex-store size value)))))
@@ -48,6 +50,13 @@
Executes first in alien blas/lapack if possible. If not it executes in lisp."))
+;;; Add classes to the generic matrix creation scheme
+(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)
+
+
;;; Level1 methods specialized for zge
(defmethod mref ((matrix matrix-base-zge) row col)
Modified: src/matrix/level2-constructors.lisp
==============================================================================
--- src/matrix/level2-constructors.lisp (original)
+++ src/matrix/level2-constructors.lisp Sun Nov 8 11:30:09 2009
@@ -62,7 +62,11 @@
(convert (list x) type)))
(defmethod mnew (type value rows &optional cols)
- (make-matrix-instance type (list rows cols) value))
+ (make-matrix-instance type
+ (if cols
+ (list rows cols)
+ rows)
+ value))
(defmacro mmat (type &body args)
"Creates a matrix."
More information about the lisplab-cvs
mailing list