[lisplab-cvs] r95 - src/matrix
Jørn Inge Vestgården
jivestgarden at common-lisp.net
Sat Sep 26 14:23:10 UTC 2009
Author: jivestgarden
Date: Sat Sep 26 10:23:09 2009
New Revision: 95
Log:
Cleaning pluss export and import of matrices
Added:
src/matrix/level1-sparse.lisp
Modified:
src/matrix/level1-classes.lisp
src/matrix/level1-util.lisp
src/matrix/level2-constructors.lisp
src/matrix/level2-generic.lisp
src/matrix/level2-interface.lisp
src/matrix/level2-matrix-zge.lisp
Modified: src/matrix/level1-classes.lisp
==============================================================================
--- src/matrix/level1-classes.lisp (original)
+++ src/matrix/level1-classes.lisp Sat Sep 26 10:23:09 2009
@@ -99,7 +99,9 @@
:accessor size
:type type-blas-idx)))
-;;; The actual classes ment for instantiation
+;;; The actual classes meant for instantiation
+
+;;;; General matrices with unspecified element types
(defclass matrix-ge
(matrix-structure-general matrix-element-base matrix-implementation-lisp)
Added: src/matrix/level1-sparse.lisp
==============================================================================
--- (empty file)
+++ src/matrix/level1-sparse.lisp Sat Sep 26 10:23:09 2009
@@ -0,0 +1,73 @@
+;;; Lisplab, level1-sparse.lisp
+;;; General sparse matrices base on hash tables
+
+;;; 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 that there is probably not much to save using this on most operations
+;;; since they by default go through all elements.
+
+
+(in-package :lisplab)
+
+(defclass matrix-sparse
+ (matrix-structure-general matrix-element-base matrix-implementation-lisp)
+ ((hash-store
+ :initarg :store
+ :initform nil
+ :reader matrix-hash-store)
+ (default-element
+ :initarg :default-element
+ :initform nil
+ :accessor matrix-default-element))
+ (:documentation "A sparse matrix"))
+
+(defmethod initialize-instance :after ((m matrix-sparse) &key (value 0))
+ (with-slots (rows cols size hash-store default-element ) m
+ (setf size (* rows cols))
+ (unless hash-store
+ (setf hash-store (make-hash-table :test 'eq)))
+ (unless default-element
+ (setf default-element value))))
+
+;;; Add clases to the description system
+(add-matrix-class 'matrix-sparse :any :sparse :any)
+
+(defmethod mref ((matrix matrix-sparse) row col)
+ (multiple-value-bind (val ok)
+ (gethash (column-major-idx row col (slot-value matrix 'rows))
+ (slot-value matrix 'hash-store))
+ (if ok
+ val
+ (slot-value matrix 'default-element))))
+
+(defmethod (setf mref) (value (matrix matrix-sparse) row col)
+ (setf (gethash (column-major-idx row col (slot-value matrix 'rows))
+ (slot-value matrix 'hash-store))
+ value))
+
+(defmethod vref ((matrix matrix-sparse) idx)
+ (multiple-value-bind (val ok)
+ (gethash idx
+ (slot-value matrix 'hash-store))
+ (if ok
+ val
+ (slot-value matrix 'default-element))))
+
+(defmethod (setf vref) (value (matrix matrix-sparse) idx)
+ (setf (gethash idx
+ (slot-value matrix 'hash-store))
+ value))
\ No newline at end of file
Modified: src/matrix/level1-util.lisp
==============================================================================
--- src/matrix/level1-util.lisp (original)
+++ src/matrix/level1-util.lisp Sat Sep 26 10:23:09 2009
@@ -1,5 +1,5 @@
;;; Lisplab, level1-util.lisp
-;;; Level1, utility functions for matrix defenitions
+;;; Level1, utility functions for matrix definitions.
;;;
;;; Copyright (C) 2009 Joern Inge Vestgaarden
@@ -72,18 +72,6 @@
(complex double-float))
(setf ref-blas-complex-store)))
-(defun fill-matrix-with-list (m x)
- (let* ((rows (rows m))
- (cols (cols m)))
- (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))
-
(defun column-major-idx (i j rows)
(truly-the type-blas-idx (+ i (truly-the type-blas-idx (* j rows)))))
Modified: src/matrix/level2-constructors.lisp
==============================================================================
--- src/matrix/level2-constructors.lisp (original)
+++ src/matrix/level2-constructors.lisp Sat Sep 26 10:23:09 2009
@@ -30,20 +30,24 @@
(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)))
-
(defmethod convert ((x matrix-base) type)
(let ((y (make-matrix-instance type (dim x) 0)))
(copy-contents x y)
y))
+(defun fill-matrix-with-list (m x)
+ "Helper function for convert."
+ (let* ((rows (rows m))
+ (cols (cols m)))
+ (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))
+
(defmethod convert ((x cons) type)
;; Should it be moved to some other file?
;; TODO some better way ... some more general guessing routine
@@ -60,7 +64,7 @@
(defmethod mnew (type value rows &optional cols)
(make-matrix-instance type (list rows cols) value))
-(defmacro mat (type &body args)
+(defmacro mmat (type &body args)
"Creates a matrix."
`(convert
,(cons 'list (mapcar (lambda (x)
@@ -68,11 +72,11 @@
args))
,type))
-(defun col (type &rest args)
+(defun mcol (type &rest args)
"Creates a column matrix."
(convert (mapcar 'list args) type))
-(defun row (type &rest args)
+(defun mrow (type &rest args)
"Creates a row matrix."
(convert args type))
@@ -84,15 +88,15 @@
(defmacro dmat (&body args)
"Creates a matrix-dge matrix."
- `(mat 'matrix-dge , at args))
+ `(mmat 'matrix-dge , at args))
(defun dcol (&rest args)
"Creates a matrix-dge column matrix."
- (apply #'col 'matrix-dge args))
+ (apply #'mcol 'matrix-dge args))
(defun drow (&rest args)
"Creates a matrix-dge row matrix."
- (apply #'row 'matrix-dge args))
+ (apply #'mrow 'matrix-dge args))
(defun dnew (value rows &optional (cols 1))
"Creates a matrix-dge matrix"
@@ -130,15 +134,15 @@
(defmacro zmat (&body args)
"Creates a matrix-dge matrix."
- `(mat 'matrix-zge , at args))
+ `(mmat 'matrix-zge , at args))
(defun zcol (&rest args)
"Creates a matrix-zge column matrix."
- (apply #'col 'matrix-zge args))
+ (apply #'mcol 'matrix-zge args))
(defun zrow (&rest args)
"Creates a matrix-zge row matrix."
- (apply #'row 'matrix-zge args))
+ (apply #'mrow 'matrix-zge args))
(defun znew (value rows &optional (cols 1))
"Creates a matrix-zge matrix"
Modified: src/matrix/level2-generic.lisp
==============================================================================
--- src/matrix/level2-generic.lisp (original)
+++ src/matrix/level2-generic.lisp Sat Sep 26 10:23:09 2009
@@ -178,6 +178,21 @@
(mref A (- i dr) (- j dc)))))
B))
+(defmethod export-list ((m matrix-base))
+ (let ((res nil))
+ (dotimes (i (size m))
+ (push (vref m i) res))
+ (nreverse res)))
+
+(defmethod import-list ((m matrix-base) list)
+ (let ((tmp list))
+ (dotimes (i (size m))
+ (unless tmp
+ (return-from import-list m))
+ (setf (vref m i) (car tmp)
+ tmp (cdr tmp)))
+ m))
+
(defmethod reshape ((a matrix-base) shape)
(let ((B (mcreate a 0 shape)))
(dotimes (i (size B))
@@ -292,7 +307,8 @@
(defmacro expand-matrix-ge-num-num ()
(cons 'progn
(mapcar (lambda (name)
- ;; Note: not using the (cdr name) , which is only valid for build in lisp types.
+ ;; Note: not using the (cdr name) , which is only valid
+ ;; for build in lisp types.
`(defmethod ,(car name) ((x matrix-ge))
(each-element-function-matrix-ge x (,(car name) x))))
+functions-real-to-real+)))
@@ -302,7 +318,6 @@
(defmethod .log ((x matrix-ge) &optional base)
(each-element-function-matrix-ge x (.log x base)))
-
;;; Bessel functions
(defmethod .besj (n (x matrix-ge))
Modified: src/matrix/level2-interface.lisp
==============================================================================
--- src/matrix/level2-interface.lisp (original)
+++ src/matrix/level2-interface.lisp Sat Sep 26 10:23:09 2009
@@ -17,9 +17,15 @@
;;; with this program; if not, write to the Free Software Foundation, Inc.,
;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+;;; TODO sort and possibly move to other levels
+
(in-package :lisplab)
-;;; TODO sort and possibly move to other levels
+(defgeneric export-list (m)
+ (:documentation "Exports the elements of the matrix to a list."))
+
+(defgeneric import-list (m list)
+ (:documentation "Imports the elements of the matrix from a list."))
(defgeneric .some (pred a &rest matrices)
(:documentation "Generalizes some"))
@@ -29,14 +35,11 @@
(defgeneric sub-matrix (m rr cc)
(:documentation "Copies a sub matrix of m. The format of rr = (start stop) or rr = (start step stop)
-and the same for the coulumns."))
+and the same for the columns."))
(defgeneric copy-contents (a b &optional converter)
(:documentation "Copies all elements from a to b."))
-(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."))
@@ -44,23 +47,12 @@
(: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."))
(defgeneric diag (v)
(:documentation "Creates a diagnoal matrix from the vector."))
-#+nil (defgeneric dlmwrite (matrix &optional file &rest args)
- (:documentation "Write all elements to a text file or stream in
-row major order. File t means standard output."))
-
-#+nil (defgeneric dlmread (class &optional file-or-stream &rest args)
- (:documentation "Reads a text file or stream and outputs a matrix"))
-
(defgeneric to-vector! (a)
(:documentation "Reshape the object to 1D. Destructive"))
@@ -112,7 +104,6 @@
(:documentation "Returns a transposed matrix with same (shared) elements"))
-
;;;; Single-element operations
(defgeneric mmap (type f m &rest args)
@@ -125,11 +116,6 @@
(defgeneric mfill (a value)
(:documentation "Sets each element to the value. Destructive"))
-#+nil (defgeneric .map (f m &rest rest)
- (:documentation "Maps the function on each element. The returned
-object has dimensionality of the first object"))
-
-
;;; Helpers
(defgeneric msum (m)
Modified: src/matrix/level2-matrix-zge.lisp
==============================================================================
--- src/matrix/level2-matrix-zge.lisp (original)
+++ src/matrix/level2-matrix-zge.lisp Sat Sep 26 10:23:09 2009
@@ -32,6 +32,14 @@
:rows (rows matrix)
:cols (cols matrix)))
+(defmethod copy-contents ((a matrix-base-zge) (b matrix-base-zge) &optional (converter nil))
+ (let ((store-a (matrix-store a))
+ (store-b (matrix-store b)))
+ (if converter
+ (map-into store-b converter store-a)
+ (copy-matrix-stores store-a store-b)))
+ b)
+
(defmethod copy-contents ((from matrix-base-dge) (to matrix-base-zge) &optional (converter nil))
(if converter
(call-next-method) ;; Could have some testes here to improve performance
More information about the lisplab-cvs
mailing list