[lisplab-cvs] r54 - src/fft src/io src/matrix
Jørn Inge Vestgården
jivestgarden at common-lisp.net
Tue Jun 9 19:49:15 UTC 2009
Author: jivestgarden
Date: Tue Jun 9 15:49:13 2009
New Revision: 54
Log:
fixes on matrix types
Added:
src/fft/level3-fft-generic.lisp
Modified:
lisplab.asd
src/fft/level3-fft-zge.lisp
src/io/level3-io.lisp
src/matrix/level2-matrix-dge.lisp
src/matrix/level2-matrix-zge.lisp
Modified: lisplab.asd
==============================================================================
--- lisplab.asd (original)
+++ lisplab.asd Tue Jun 9 15:49:13 2009
@@ -87,6 +87,7 @@
:components
(
(:file "level3-fft-interface")
+ (:file "level3-fft-generic")
(:file "level3-fft-zge")))
;;
Added: src/fft/level3-fft-generic.lisp
==============================================================================
--- (empty file)
+++ src/fft/level3-fft-generic.lisp Tue Jun 9 15:49:13 2009
@@ -0,0 +1,55 @@
+;;; Lisplab, level3-fft-generic.lisp
+;;; Simple converters is the to the methods that do calculations
+
+;;; 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)
+
+(defun convert-to-matrix-zge (m)
+ (let ((m-copy (make-matrix-instance (create-matrix-description m :et :z)
+ (dim m)
+ 0)))
+ (copy-contents m m-copy)
+ m-copy))
+
+;;;; Real matrices
+
+(defmethod fft1 ((x matrix-base-dge))
+ (fft1! (convert-to-matrix-zge x)))
+
+(defmethod ifft1 ((x matrix-base-dge))
+ (ifft1! (convert-to-matrix-zge x)))
+
+(defmethod ifft2 ((x matrix-base-dge))
+ (ifft2! (convert-to-matrix-zge x)))
+
+(defmethod fft2 ((x matrix-base-dge))
+ (fft2! (convert-to-matrix-zge x)))
+
+;;; Complex matrices
+
+(defmethod fft1 ((x matrix-base-zge))
+ (fft1! (copy x)))
+
+(defmethod ifft1 ((x matrix-base-zge))
+ (ifft1! (copy x)))
+
+(defmethod ifft2 ((x matrix-base-zge))
+ (ifft2! (copy x)))
+
+(defmethod fft2 ((x matrix-base-zge))
+ (fft2! (copy x)))
Modified: src/fft/level3-fft-zge.lisp
==============================================================================
--- src/fft/level3-fft-zge.lisp (original)
+++ src/fft/level3-fft-zge.lisp Tue Jun 9 15:49:13 2009
@@ -1,4 +1,4 @@
-;;; Lisplab, level3-fft-blas.lisp
+;;; Lisplab, level3-fft-zge.lisp
;;; Methods for fast Fourier transforms specialized on blas matrices.
;;; Copyright (C) 2009 Joern Inge Vestgaarden
@@ -17,41 +17,10 @@
;;; with this program; if not, write to the Free Software Foundation, Inc.,
;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-;;; TODO should use the normal ref-blas-complex-store
-
-;;; TODO fix the methods so that they use the actual input matrix type, not just
-;;; the eql spezializer.
+;;; TODO should use the normal ref-blas-complex-store ?
(in-package :lisplab)
-;;;; Real matrices
-
-(defmethod fft1 ((x matrix-lisp-dge))
- (fft1! (convert x 'matrix-zge)))
-
-(defmethod ifft1 ((x matrix-lisp-dge))
- (ifft1! (convert x 'matrix-zge)))
-
-(defmethod ifft2 ((x matrix-lisp-dge))
- (ifft2! (convert x 'matrix-zge)))
-
-(defmethod fft2 ((x matrix-lisp-dge))
- (fft2! (convert x 'matrix-zge)))
-
-;;; Complex matrices
-
-(defmethod fft1 ((x matrix-lisp-zge))
- (fft1! (copy x)))
-
-(defmethod ifft1 ((x matrix-lisp-zge))
- (ifft1! (copy x)))
-
-(defmethod ifft2 ((x matrix-lisp-zge))
- (ifft2! (copy x)))
-
-(defmethod fft2 ((x matrix-lisp-zge))
- (fft2! (copy x)))
-
;;;; The implementing methods
(defmethod fft1! ((x matrix-lisp-zge))
Modified: src/io/level3-io.lisp
==============================================================================
--- src/io/level3-io.lisp (original)
+++ src/io/level3-io.lisp Tue Jun 9 15:49:13 2009
@@ -25,7 +25,7 @@
(in-package :lisplab)
-(export '(pgmwrite dlmread dlmwrite))
+(export '(pgmwrite dlmread dlmwrite pswrite))
(defun dlmwrite (a &optional (out t)
&key
@@ -87,8 +87,8 @@
(let* ((rows (rows m))
(cols (cols m))
(scale (- max min)))
- (if (<= (- max min) 0.0)
- (setf max 1.0 min 0.0 scale 1.0))
+ (when (<= (- max min) 0.0)
+ (setf max 1.0 min 0.0 scale 1.0))
(with-open-file (out filename :direction :output :if-exists :supersede)
(format out "P5~%")
(format out "~A ~A~%" cols rows)
@@ -114,6 +114,9 @@
"Writes matrix as postsrcipt bitmap. Port of a2ps.c by Eric Weeks."
;; TODO: clean up and some more lispifying.
;; TODO: more testing.
+ ;; TOOD: change name to epswrite.
+ (when (<= (- max min) 0.0)
+ (setf max 1.0 min 0.0 ))
(let* ((DTXSCALE 1.0787)
(DTYSCALE 1.0)
(DTHRES 513)
Modified: src/matrix/level2-matrix-dge.lisp
==============================================================================
--- src/matrix/level2-matrix-dge.lisp (original)
+++ src/matrix/level2-matrix-dge.lisp Tue Jun 9 15:49:13 2009
@@ -19,19 +19,19 @@
(in-package :lisplab)
-(defmethod fill! ((a matrix-lisp-dge) value)
+(defmethod fill! ((a matrix-base-dge) value)
(let ((x (coerce value 'double-float))
(store (matrix-store a)))
(declare (type type-blas-store store))
(fill store x)))
-(defmethod copy ((matrix matrix-lisp-dge))
+(defmethod copy ((matrix matrix-base-dge))
(make-instance (class-name (class-of matrix))
:store (copy-seq (the type-blas-store (matrix-store matrix)))
:rows (rows matrix)
:cols (cols matrix)))
-(defmethod .map (f (a matrix-lisp-dge) &rest args)
+(defmethod .map (f (a matrix-base-dge) &rest args)
(let ((b (copy a)))
(apply #'map-into
(matrix-store b)
@@ -40,29 +40,29 @@
(matrix-store a) (mapcar #'matrix-store args))
b))
-(defmethod .imagpart ((a matrix-lisp-dge))
+(defmethod .imagpart ((a matrix-base-dge))
(mcreate a 0))
-(defmethod .realpart ((a matrix-lisp-dge))
+(defmethod .realpart ((a matrix-base-dge))
(copy a))
-(defmethod .abs ((a matrix-lisp-dge))
+(defmethod .abs ((a matrix-base-dge))
(let ((b (mcreate a)))
(copy-contents a b #'abs)
b))
-(defmethod .conj ((a matrix-lisp-dge))
+(defmethod .conj ((a matrix-base-dge))
(copy a))
-(defmethod .some (pred (a matrix-lisp-dge) &rest args)
+(defmethod .some (pred (a matrix-base-dge) &rest args)
(let ((stores (mapcar #'matrix-store (cons a args))))
(apply #'some pred stores)))
-(defmethod .every (pred (a matrix-lisp-dge) &rest args)
+(defmethod .every (pred (a matrix-base-dge) &rest args)
(let ((stores (mapcar #'matrix-store (cons a args))))
(apply #'every pred stores)))
-(defmacro def-binary-op-matrix-lisp-dge (new old)
+(defmacro def-binary-op-matrix-base-dge (new old)
(let ((a (gensym "a"))
(b (gensym "b"))
(len (gensym "len"))
@@ -70,7 +70,7 @@
(store2 (gensym "store2"))
(i (gensym "i")))
`(progn
- (defmethod ,new ((,a matrix-lisp-dge) (,b real))
+ (defmethod ,new ((,a matrix-base-dge) (,b real))
(let* ((,a (copy ,a))
(,store (matrix-store ,a))
(,b (coerce ,b 'double-float))
@@ -81,7 +81,7 @@
(dotimes (,i ,len)
(setf (aref ,store ,i) (,old (aref ,store ,i) ,b)))
,a))
- (defmethod ,new ((,a real) (,b matrix-lisp-dge))
+ (defmethod ,new ((,a real) (,b matrix-base-dge))
(let* ((,b (copy ,b))
(,store (matrix-store ,b))
(,a (coerce ,a 'double-float))
@@ -92,7 +92,7 @@
(dotimes (,i ,len)
(setf (aref ,store ,i) (,old ,a (aref ,store ,i))))
,b))
- (defmethod ,new ((,a matrix-lisp-dge) (,b matrix-lisp-dge))
+ (defmethod ,new ((,a matrix-base-dge) (,b matrix-base-dge))
(let* ((,a (copy ,a))
(,store (matrix-store ,a))
(,store2 (matrix-store ,b))
@@ -104,15 +104,15 @@
(setf (aref ,store ,i) (,old (aref ,store ,i) (aref ,store2 ,i))))
,a)))))
-(def-binary-op-matrix-lisp-dge .add +)
+(def-binary-op-matrix-base-dge .add +)
-(def-binary-op-matrix-lisp-dge .mul *)
+(def-binary-op-matrix-base-dge .mul *)
-(def-binary-op-matrix-lisp-dge .sub -)
+(def-binary-op-matrix-base-dge .sub -)
-(def-binary-op-matrix-lisp-dge .div /)
+(def-binary-op-matrix-base-dge .div /)
-(def-binary-op-matrix-lisp-dge .expt expt)
+(def-binary-op-matrix-base-dge .expt expt)
(defmacro each-matrix-element-df-to-df (x form)
"Applies a form on each element of an matrix-dge. The form must
@@ -146,50 +146,50 @@
;;; Trignometric functions
-(defmethod .sin ((x matrix-lisp-dge))
+(defmethod .sin ((x matrix-base-dge))
(each-matrix-element-df-to-df x (sin x)))
-(defmethod .cos ((x matrix-lisp-dge))
+(defmethod .cos ((x matrix-base-dge))
(each-matrix-element-df-to-df x (cos x)))
-(defmethod .tan ((x matrix-lisp-dge))
+(defmethod .tan ((x matrix-base-dge))
(each-matrix-element-df-to-df x (tan x)))
;;; Hyperbolic functions
-(defmethod .sinh ((x matrix-lisp-dge))
+(defmethod .sinh ((x matrix-base-dge))
(each-matrix-element-df-to-df x (sinh x)))
-(defmethod .cosh ((x matrix-lisp-dge))
+(defmethod .cosh ((x matrix-base-dge))
(each-matrix-element-df-to-df x (cosh x)))
-(defmethod .tanh ((x matrix-lisp-dge))
+(defmethod .tanh ((x matrix-base-dge))
(each-matrix-element-df-to-df x (tanh x)))
-(defmethod .log ((x matrix-lisp-dge) &optional base)
+(defmethod .log ((x matrix-base-dge) &optional base)
(if base
(each-matrix-element-df-to-df x (log x base))
(each-matrix-element-df-to-df x (log x))))
-(defmethod .exp ((x matrix-lisp-dge))
+(defmethod .exp ((x matrix-base-dge))
(each-matrix-element-df-to-df x (exp x)))
;;; Bessel functions
-(defmethod .besj (n (x matrix-lisp-dge))
+(defmethod .besj (n (x matrix-base-dge))
(each-matrix-element-df-to-df x (.besj n x)))
-(defmethod .besy (n (x matrix-lisp-dge))
+(defmethod .besy (n (x matrix-base-dge))
(each-matrix-element-df-to-df x (.besy n x)))
-(defmethod .besi (n (x matrix-lisp-dge))
+(defmethod .besi (n (x matrix-base-dge))
(each-matrix-element-df-to-df x (.besi n x)))
-(defmethod .besk (n (x matrix-lisp-dge))
+(defmethod .besk (n (x matrix-base-dge))
(each-matrix-element-df-to-df x (.besk n x)))
-(defmethod .besh1 (n (x matrix-lisp-dge))
+(defmethod .besh1 (n (x matrix-base-dge))
(each-matrix-element-df-to-complex-df x (.besh1 n x)))
-(defmethod .besh2 (n (x matrix-lisp-dge))
+(defmethod .besh2 (n (x matrix-base-dge))
(each-matrix-element-df-to-complex-df x (.besh2 n x)))
\ No newline at end of file
Modified: src/matrix/level2-matrix-zge.lisp
==============================================================================
--- src/matrix/level2-matrix-zge.lisp (original)
+++ src/matrix/level2-matrix-zge.lisp Tue Jun 9 15:49:13 2009
@@ -18,7 +18,7 @@
(in-package :lisplab)
-(defmethod fill! ((a matrix-zge) value)
+(defmethod fill! ((a matrix-base-zge) value)
(let ((rx (coerce (realpart value) 'double-float))
(cx (coerce (imagpart value) 'double-float))
(store (matrix-store a)))
@@ -26,25 +26,25 @@
(setf (aref store i) rx
(aref store (1+ i)) cx))))
-(defmethod copy ((matrix matrix-lisp-zge))
+(defmethod copy ((matrix matrix-base-zge))
(make-instance (class-name (class-of matrix))
:store (copy-seq (the type-blas-store (matrix-store matrix)))
:rows (rows matrix)
:cols (cols matrix)))
-(defmethod .imagpart ((a matrix-lisp-zge))
+(defmethod .imagpart ((a matrix-base-zge))
(let* ((description (create-matrix-description a :et :d))
(b (make-matrix-instance description (dim a) 0)))
(copy-contents a b #'imagpart)
b))
-(defmethod .realpart ((a matrix-lisp-zge))
+(defmethod .realpart ((a matrix-base-zge))
(let* ((description (create-matrix-description a :et :d))
(b (make-matrix-instance description (dim a) 0)))
(copy-contents a b #'realpart)
b))
-(defmethod .abs ((a matrix-lisp-zge))
+(defmethod .abs ((a matrix-base-zge))
(let* ((description (create-matrix-description a :et :d))
(b (make-matrix-instance description (dim a) 0)))
(copy-contents a b #'abs)
@@ -59,7 +59,7 @@
(store2 (gensym "store2"))
(i (gensym "i")))
`(progn
- (defmethod ,new ((,a matrix-zge) (,b number))
+ (defmethod ,new ((,a matrix-base-zge) (,b number))
(let* ((,a (copy ,a))
(,store (matrix-store ,a))
(,b (coerce ,b '(complex double-float)))
@@ -71,7 +71,7 @@
(setf (ref-blas-complex-store ,store ,i 0 ,len)
(,old (ref-blas-complex-store ,store ,i 0 ,len) ,b)))
,a))
- (defmethod ,new ((,a number) (,b matrix-zge))
+ (defmethod ,new ((,a number) (,b matrix-base-zge))
(let* ((,b (copy ,b))
(,store (matrix-store ,b))
(,a (coerce ,a '(complex double-float)))
@@ -83,7 +83,7 @@
(setf (ref-blas-complex-store ,store ,i 0 ,len)
(,old ,a (ref-blas-complex-store ,store ,i 0 ,len))))
,b))
- (defmethod ,new ((,a matrix-zge) (,b matrix-zge))
+ (defmethod ,new ((,a matrix-base-zge) (,b matrix-base-zge))
(let* ((,a (copy ,a))
(,store (matrix-store ,a))
(,store2 (matrix-store ,b))
@@ -97,7 +97,7 @@
(,old (ref-blas-complex-store ,store ,i 0 ,len)
(ref-blas-complex-store ,store2 ,i 0 ,len))))
,a))
- (defmethod ,new ((,a matrix-zge) (,b matrix-dge))
+ (defmethod ,new ((,a matrix-base-zge) (,b matrix-base-dge))
(let* ((,a (copy ,a))
(,store (matrix-store ,a))
(,store2 (matrix-store ,b))
@@ -110,7 +110,7 @@
(,old (ref-blas-complex-store ,store ,i 0 ,len)
(aref ,store2 ,i))))
,a))
- (defmethod ,new ((,a matrix-dge) (,b matrix-zge))
+ (defmethod ,new ((,a matrix-base-dge) (,b matrix-base-zge))
(let* ((,b (copy ,b))
(,store (matrix-store ,a))
(,store2 (matrix-store ,b))
@@ -134,12 +134,12 @@
(def-binary-op-blas-complex .expt expt)
-(defmacro each-element-function-matrix-zge (x form)
- "Applies a form on each element of an matrix-zge."
+(defmacro each-element-function-matrix-base-zge (x form)
+ "Applies a form on each element of an matrix-base-zge."
(let ((i (gensym))
(y (gensym)))
`(let* ((,y (copy ,x)))
- (declare (type matrix-zge ,y))
+ (declare (type matrix-base-zge ,y))
(dotimes (,i (size ,y))
(let ((,x (vref ,y ,i)))
(declare (type (complex double-float) ,x))
@@ -147,55 +147,55 @@
,form)))
,y)))
-(defmethod .conj ((x matrix-lisp-zge))
- (each-element-function-matrix-zge x (conjugate x)))
+(defmethod .conj ((x matrix-base-zge))
+ (each-element-function-matrix-base-zge x (conjugate x)))
;;; Trignometric functions
-(defmethod .sin ((x matrix-lisp-zge))
- (each-element-function-matrix-zge x (sin x)))
+(defmethod .sin ((x matrix-base-zge))
+ (each-element-function-matrix-base-zge x (sin x)))
-(defmethod .cos ((x matrix-lisp-zge))
- (each-element-function-matrix-zge x (cos x)))
+(defmethod .cos ((x matrix-base-zge))
+ (each-element-function-matrix-base-zge x (cos x)))
-(defmethod .tan ((x matrix-lisp-zge))
- (each-element-function-matrix-zge x (tan x)))
+(defmethod .tan ((x matrix-base-zge))
+ (each-element-function-matrix-base-zge x (tan x)))
;;; Hyperbolic functions
-(defmethod .sinh ((x matrix-lisp-zge))
- (each-element-function-matrix-zge x (sinh x)))
+(defmethod .sinh ((x matrix-base-zge))
+ (each-element-function-matrix-base-zge x (sinh x)))
-(defmethod .cosh ((x matrix-lisp-zge))
- (each-element-function-matrix-zge x (cosh x)))
+(defmethod .cosh ((x matrix-base-zge))
+ (each-element-function-matrix-base-zge x (cosh x)))
-(defmethod .tanh ((x matrix-lisp-zge))
- (each-element-function-matrix-zge x (tanh x)))
+(defmethod .tanh ((x matrix-base-zge))
+ (each-element-function-matrix-base-zge x (tanh x)))
-(defmethod .log ((x matrix-lisp-zge) &optional base)
+(defmethod .log ((x matrix-base-zge) &optional base)
(if base
- (each-element-function-matrix-zge x (log x base))
- (each-element-function-matrix-zge x (log x))))
+ (each-element-function-matrix-base-zge x (log x base))
+ (each-element-function-matrix-base-zge x (log x))))
-(defmethod .exp ((x matrix-lisp-zge))
- (each-element-function-matrix-zge x (exp x)))
+(defmethod .exp ((x matrix-base-zge))
+ (each-element-function-matrix-base-zge x (exp x)))
;;; Bessel functions
-(defmethod .besj (n (x matrix-lisp-zge))
- (each-element-function-matrix-zge x (.besj n x)))
+(defmethod .besj (n (x matrix-base-zge))
+ (each-element-function-matrix-base-zge x (.besj n x)))
-(defmethod .besy (n (x matrix-lisp-zge))
- (each-element-function-matrix-zge x (.besy n x)))
+(defmethod .besy (n (x matrix-base-zge))
+ (each-element-function-matrix-base-zge x (.besy n x)))
-(defmethod .besi (n (x matrix-lisp-zge))
- (each-element-function-matrix-zge x (.besi n x)))
+(defmethod .besi (n (x matrix-base-zge))
+ (each-element-function-matrix-base-zge x (.besi n x)))
-(defmethod .besk (n (x matrix-lisp-zge))
- (each-element-function-matrix-zge x (.besk n x)))
+(defmethod .besk (n (x matrix-base-zge))
+ (each-element-function-matrix-base-zge x (.besk n x)))
-(defmethod .besh1 (n (x matrix-lisp-zge))
- (each-element-function-matrix-zge x (.besh1 n x)))
+(defmethod .besh1 (n (x matrix-base-zge))
+ (each-element-function-matrix-base-zge x (.besh1 n x)))
-(defmethod .besh2 (n (x matrix-lisp-zge))
- (each-element-function-matrix-zge x (.besh2 n x)))
+(defmethod .besh2 (n (x matrix-base-zge))
+ (each-element-function-matrix-base-zge x (.besh2 n x)))
More information about the lisplab-cvs
mailing list