[lisplab-cvs] r42 - in src: core matrix
Jørn Inge Vestgården
jivestgarden at common-lisp.net
Sun May 24 11:37:25 UTC 2009
Author: jivestgarden
Date: Sun May 24 07:37:23 2009
New Revision: 42
Log:
fixes and added incomplete view
Added:
src/matrix/level2-view.lisp
Modified:
src/core/level0-generic.lisp
src/core/level0-interface.lisp
src/matrix/level1-classes.lisp
src/matrix/level2-generic.lisp
src/matrix/level2-matrix-zge.lisp
Modified: src/core/level0-generic.lisp
==============================================================================
--- src/core/level0-generic.lisp (original)
+++ src/core/level0-generic.lisp Sun May 24 07:37:23 2009
@@ -21,34 +21,40 @@
(export '(.+ .* ./ .- .^ ^))
+(defmethod copy (a)
+ ;; Hm this is dagenrous if someone forgets to overload copy.
+ a)
+
+(defmethod scalar? ((a number))
+ t) ;; Is this right?
+
(defun ^ (x n) "Synonym for expt" (expt x n))
(defun .+ (&rest args)
+ "Generlized +. Reduces the arguments with .add."
(if (and args (cdr args))
(reduce #'.add args)
(car args)))
(defun .* (&rest args)
+ "Generalized *. Reduces the arguments with .mul."
(if (and args (cdr args))
(reduce #'.mul args)
(car args)))
(defun ./ (&rest args)
+ "Generalized /. Reduces the arguments with .div."
(if (and args (cdr args))
(reduce #'.div args)
(./ 1 (car args))))
(defun .- (&rest args)
+ "Generalized -. Reduces the arguments with .sub."
(if (and args (cdr args))
(reduce #'.sub args)
(.- 0 (car args))))
(defun .^ (&rest args)
+ "Generlized expt. Reduces the arguments with .expt."
(reduce #'.expt args))
-(defmethod copy (a)
- ;; Hm this is dagenrous if someone forgets to overload copy.
- a)
-
-(defmethod scalar? ((a number))
- t) ;; Is this right?
Modified: src/core/level0-interface.lisp
==============================================================================
--- src/core/level0-interface.lisp (original)
+++ src/core/level0-interface.lisp Sun May 24 07:37:23 2009
@@ -54,7 +54,7 @@
shared state, like fill pointers etc."))
(defgeneric convert (x type)
- (:documentation "Generalized coerce."))
+ (:documentation "Converts the object to the specified type. Non-destructive."))
(defgeneric .abs (a)
(:documentation "Generialized abs."))
Modified: src/matrix/level1-classes.lisp
==============================================================================
--- src/matrix/level1-classes.lisp (original)
+++ src/matrix/level1-classes.lisp Sun May 24 07:37:23 2009
@@ -221,6 +221,9 @@
: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))))
Modified: src/matrix/level2-generic.lisp
==============================================================================
--- src/matrix/level2-generic.lisp (original)
+++ src/matrix/level2-generic.lisp Sun May 24 07:37:23 2009
@@ -24,35 +24,9 @@
(in-package :lisplab)
-(defmethod .conj ((a matrix-element-complex-double-float))
- (let ((b (mcreate a)))
- (dotimes (i (size b))
- (setf (vref b i) (conjugate (vref a i))))
- b))
-
-
-
-;; Helper function.
-#+nil (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.
-#+nil (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 square-matrix? ((x matrix-base))
(= (rows x) (cols x)))
-
;;; This is OK, but could be optimzied!
(defmacro w/mat (a args &body body)
(let ((a2 (gensym))
@@ -104,13 +78,6 @@
(defmethod .map (f (a matrix-base) &rest args)
(apply #'mmap (class-name (class-of a)) f a args))
-#+todo-remove (defmethod diag (v)
- (let* ((n (size v))
- (a (mcreate v 0 (list n n))))
- (dotimes (i n)
- (setf (mref a i i) (vref v i)))
- a))
-
(defmethod msum ((m matrix-base))
"Sums all elements of m."
(let ((sum 0))
@@ -194,12 +161,8 @@
(defmethod to-matrix ((a matrix-base) rows)
(reshape a (list rows (/ (size a) rows) 1)))
-
;;;; Basic boolean operators
-
-;;;; The boolean operators
-
(defmethod .= ((a matrix-base) (b matrix-base) &optional acc)
(if acc
(.every (lambda (a b) (.= a b acc)) a b)
@@ -243,7 +206,6 @@
(def-matrix-base-boolean-operator .>=)
-
;; Specialize operators for matrix-ge. It is dangerous to spezialize for matrix-base
;; since the output type depends on the kind of operator. It is possible to
;; make it better by separating between complex and real number and matrices, but
@@ -294,6 +256,20 @@
,form)))
,y)))
+
+
+(defmethod .imagpart ((x matrix-ge))
+ (each-element-function-matrix-ge x (.imagpart x)))
+
+(defmethod .realpart ((x matrix-ge))
+ (each-element-function-matrix-ge x (.realpart x)))
+
+(defmethod .abs ((x matrix-ge))
+ (each-element-function-matrix-ge x (.abs x)))
+
+(defmethod .conj ((x matrix-ge))
+ (each-element-function-matrix-ge x (.conj x)))
+
;;; Trignometric functions
(defmethod .sin ((x matrix-ge))
@@ -345,53 +321,3 @@
;;; TRASH
-
-#+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))
-
-;;; 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))
Modified: src/matrix/level2-matrix-zge.lisp
==============================================================================
--- src/matrix/level2-matrix-zge.lisp (original)
+++ src/matrix/level2-matrix-zge.lisp Sun May 24 07:37:23 2009
@@ -147,6 +147,9 @@
,form)))
,y)))
+(defmethod .conj ((x matrix-lisp-zge))
+ (each-element-function-matrix-zge x (conjugate x)))
+
;;; Trignometric functions
(defmethod .sin ((x matrix-lisp-zge))
Added: src/matrix/level2-view.lisp
==============================================================================
--- (empty file)
+++ src/matrix/level2-view.lisp Sun May 24 07:37:23 2009
@@ -0,0 +1,107 @@
+;;; Level2-view.lisp
+;;; Matrix views
+
+;;; 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)
+
+#+todo-make-this(defmethod view-matrix (matrix shape &optional (type))
+ "Outputs a function matrix"
+ (declare (ignore type))
+ (let* ((rows (car shape))
+ (cols (cadr shape))
+ (size (* rows cols)))
+ (make-instance 'function-matrix
+ :rows rows
+ :cols cols
+ :size size
+ :element-type (element-type matrix)
+ :mref #'(lambda (x i j)
+ (declare (ignore x))
+ (vref matrix (column-major-idx i j rows)))
+ :set-mref #'(lambda (value x i j)
+ (declare (ignore x))
+ (setf (vref matrix (column-major-idx i j rows)) value))
+ :vref #'(lambda (x i)
+ (declare (ignore x))
+ (vref matrix i))
+ :set-vref #'(lambda (value x i)
+ (declare (ignore x))
+ (setf (vref matrix i) value)))))
+
+(defmethod view-row (matrix row)
+ "Outputs a function matrix."
+ (make-instance
+ 'function-matrix
+ :rows (cols matrix)
+ :cols 1
+ :mref #'(lambda (x i j)
+ (declare (ignore x j))
+ (mref matrix row i))
+ :set-mref #'(lambda (value x i j)
+ (declare (ignore x i))
+ (setf (mref matrix row j) value))
+ :vref #'(lambda (x i)
+ (declare (ignore x))
+ (mref matrix row i))
+ :set-vref #'(lambda (value x i)
+ (declare (ignore x))
+ (setf (mref matrix row i) value))))
+
+(defmethod view-col (matrix col)
+ "Outputs a function matrix."
+ (make-instance
+ 'function-matrix
+ :rows (rows matrix)
+ :cols 1
+ :mref #'(lambda (x i j)
+ (declare (ignore x j))
+ (mref matrix i col))
+ :set-mref #'(lambda (value x i j)
+ (declare (ignore x j))
+ (setf (mref matrix i col) value))
+ :vref #'(lambda (x i)
+ (declare (ignore x))
+ (mref matrix i col))
+ :set-vref #'(lambda (value x i)
+ (declare (ignore x))
+ (setf (mref matrix i col) value))))
+
+#+todo-make-this(defmethod view-transpose (matrix)
+ "Outputs a function matrix"
+ (make-instance 'function-matrix
+ :rows (cols matrix)
+ :cols (rows matrix)
+ :size (size matrix)
+ :element-type (element-type matrix)
+ :mref #'(lambda (x i j)
+ (declare (ignore x))
+ (mref matrix j i))
+ :set-mref #'(lambda (value x i j)
+ (declare (ignore x))
+ (setf (mref matrix j i) value))
+ :vref #'(lambda (x i)
+ (declare (ignore x))
+ (vref matrix i))
+ :set-vref #'(lambda (value x i)
+ (declare (ignore x))
+ (setf (vref matrix i) value))))
+
+
+
+
+
More information about the lisplab-cvs
mailing list