[lisplab-cvs] r96 - doc/manual src/io src/linalg src/test
Jørn Inge Vestgården
jivestgarden at common-lisp.net
Sat Sep 26 18:26:50 UTC 2009
Author: jivestgarden
Date: Sat Sep 26 14:26:49 2009
New Revision: 96
Log:
fixed dlmread and dlmwrite
Added:
src/io/level3-io-interface.lisp
Modified:
doc/manual/lisplab.texi
lisplab.asd
package.lisp
src/io/level3-io.lisp
src/linalg/level3-linalg-generic.lisp
src/test/test-methods.lisp
Modified: doc/manual/lisplab.texi
==============================================================================
--- doc/manual/lisplab.texi (original)
+++ doc/manual/lisplab.texi Sat Sep 26 14:26:49 2009
@@ -296,7 +296,7 @@
while @code{dmat} is a macro. Similarly, there are
@code{znew}, @code{zcol}, @code{zrow}, and @code{zmat}
for double float matrices and
- at code{new}, @code{col}, @code{row}, and @code{mat}
+ at code{mnew}, @code{mcol}, @code{mrow}, and @code{mmat}
for any matrices. The latter take matrix class as first argument.
Often you want to create a matrix of the same type as a input
Modified: lisplab.asd
==============================================================================
--- lisplab.asd (original)
+++ lisplab.asd Sat Sep 26 14:26:49 2009
@@ -66,6 +66,7 @@
(:file "level1-classes")
(:file "level1-constructors")
(:file "level1-matrix")
+ (:file "level1-sparse")
(:file "level1-array")
(:file "level2-interface")
@@ -84,7 +85,7 @@
(:module :src/io
:depends-on (:src/matrix)
:components
- (
+ ((:file "level3-io-interface")
(:file "level3-io")))
;;
Modified: package.lisp
==============================================================================
--- package.lisp (original)
+++ package.lisp Sat Sep 26 14:26:49 2009
@@ -140,11 +140,10 @@
"ROWS"
"COLS"
;; Matrix level 2 constructors
- "FUNMAT"
- "FMAT"
- "MAT"
- "COL"
- "ROW"
+ "MNEW"
+ "MMAT"
+ "MCOL"
+ "MROW"
"DMAT"
"DNEW"
"DCOL"
@@ -156,15 +155,17 @@
"ZNEW"
"ZCOL"
"ZROW"
+ "FUNMAT"
+ "FMAT"
;; Matrix level 2 methods
".EVERY"; to level0 or change name?
".SOME" ; to level0 or change name?
"SQUARE-MATRIX?"
- "MNEW"
"MCREATE"
"COPY-CONTENTS"
-
+ "EXPORT-LIST"
+ "IMPORT-LIST"
"MMAP"
"MMAP-INTO"
"MFILL"
Added: src/io/level3-io-interface.lisp
==============================================================================
--- (empty file)
+++ src/io/level3-io-interface.lisp Sat Sep 26 14:26:49 2009
@@ -0,0 +1,27 @@
+;;; Lisplab, level3-io.lisp
+;;; Input output operations
+
+;;; 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)
+
+(defgeneric dlmwrite (matrix file-or-stream &key dlm printer)
+ (:documentation "Write matrix to ASCII-delimited file or stream"))
+
+(defgeneric dlmread (class in)
+ (:documentation "Reads a delimited anscii test file and returns a matrix.
+Currently only space delimited."))
Modified: src/io/level3-io.lisp
==============================================================================
--- src/io/level3-io.lisp (original)
+++ src/io/level3-io.lisp Sat Sep 26 14:26:49 2009
@@ -25,56 +25,65 @@
(in-package :lisplab)
-(defun dlmwrite (a &optional (out t)
+(defmethod dlmwrite ((a matrix-base)
+ (stream stream)
&key
(dlm " ")
- (fmt "~S"))
- "Write matrix as a delimited anscii test file."
- (let* ((out (if (eq out t) *standard-output* out)))
- (flet ((printit (out)
- (if (scalar? a)
- (prin1 a out)
- (progn
- (format out "~&")
- (dotimes (i (rows a))
- (dotimes (j (cols a))
- (format out fmt (mref a i j))
- (when (< j (1- (cols a)))
- (princ dlm out)))
- (when (< i (1- (rows a)))
- (princ #\Newline out)))))))
- (if (streamp out)
- (printit out)
- (with-open-file (out out :direction :output :if-exists :supersede)
- (printit out))))))
+ (printer #'prin1))
+ (dotimes (i (rows a))
+ (format stream "~&")
+ (dotimes (j (cols a))
+ (funcall printer (mref a i j) stream)
+ (when (< j (1- (cols a)))
+ (princ dlm stream)))))
-(defun dlmread (class &optional (in t))
- "Reads a delimited anscii test file and returns a matrix. Currently only space delimited."
+(defmethod dlmwrite ((a matrix-base)
+ (name pathname)
+ &key
+ (dlm " ")
+ (printer #'prin1))
+ (with-open-file (stream name :direction :output :if-exists :supersede)
+ (dlmwrite a stream :dlm dlm :printer printer)))
+
+(defmethod dlmwrite ((a matrix-base)
+ (name string)
+ &key
+ (dlm " ")
+ (printer #'prin1))
+ (dlmwrite a (pathname name) :dlm dlm :printer printer))
+
+(defun dlmread-list (in)
+ "Helper function that reads a delimited file as a list of lists."
;; TODO: Fixit. Non-space formated matrices
- (let* ((in (if (eq in t) *standard-input* in))
- (end (gensym))
+ (let* ((end (gensym))
(rows nil))
- (labels ((line (in) (let ((line (read-line in nil end nil)))
- (if (eq line end)
- end
- (if (eql (char line 0) #\#)
- (line in)
- line))))
- (element (in) (read in nil end nil))
- (getit (in)
- (do ((line (line in) (line in)))
- ((eq line end))
- (let ((s (make-string-input-stream line))
- (cols nil))
- (do ((elm (element s) (element s)))
- ((eq elm end))
- (push elm cols))
- (push (reverse cols) rows)))))
- (if (streamp in)
- (getit in)
- (with-open-file (in in :direction :input)
- (getit in))))
- (convert (reverse rows) class)))
+ (labels ((line () (let ((line (read-line in nil end nil)))
+ (if (eq line end)
+ end
+ (if (eql (char line 0) #\#)
+ (line)
+ line)))))
+ (do ((line (line) (line)))
+ ((eq line end))
+ (let ((s (make-string-input-stream line))
+ (cols nil))
+ (flet ((element () (read s nil end nil)))
+ (do ((elm (element) (element)))
+ ((eq elm end))
+ (push elm cols))
+ (push (nreverse cols) rows))))
+ (nreverse rows))))
+
+(defmethod dlmread (class (in stream))
+ (convert (dlmread-list in)
+ class))
+
+(defmethod dlmread (class (name pathname))
+ (with-open-file (in name :direction :input)
+ (dlmread class in)))
+
+(defmethod dlmread (class (name string))
+ (dlmread class (pathname name)))
(defun pgmwrite (m filename
&key
@@ -109,7 +118,7 @@
(verbose nil)
(max (mmax m))
(min (mmin m)))
- "Writes matrix as postsrcipt bitmap. Port of a2ps.c by Eric Weeks."
+ "Writes matrix as postscript bitmap. Port of a2ps.c by Eric Weeks."
;; TODO: clean up and some more lispifying.
;; TODO: more testing.
;; TOOD: change name to epswrite.
@@ -168,3 +177,57 @@
(format out "~%"))
(format out "showpage~%"))))
+
+;;;; Trash
+
+
+#+nil (defun dlmwrite (a &optional (out t)
+ &key
+ (dlm " ")
+ (fmt "~S"))
+ "Write matrix as a delimited anscii test file."
+ (let* ((out (if (eq out t) *standard-output* out)))
+ (flet ((printit (out)
+ (if (scalar? a)
+ (prin1 a out)
+ (progn
+ (format out "~&")
+ (dotimes (i (rows a))
+ (dotimes (j (cols a))
+ (format out fmt (mref a i j))
+ (when (< j (1- (cols a)))
+ (princ dlm out)))
+ (when (< i (1- (rows a)))
+ (princ #\Newline out)))))))
+ (if (streamp out)
+ (printit out)
+ (with-open-file (out out :direction :output :if-exists :supersede)
+ (printit out))))))
+
+#+nil (defun dlmread (class &optional (in t))
+ "Reads a delimited anscii test file and returns a matrix. Currently only space delimited."
+ ;; TODO: Fixit. Non-space formated matrices
+ (let* ((in (if (eq in t) *standard-input* in))
+ (end (gensym))
+ (rows nil))
+ (labels ((line (in) (let ((line (read-line in nil end nil)))
+ (if (eq line end)
+ end
+ (if (eql (char line 0) #\#)
+ (line in)
+ line))))
+ (element (in) (read in nil end nil))
+ (getit (in)
+ (do ((line (line in) (line in)))
+ ((eq line end))
+ (let ((s (make-string-input-stream line))
+ (cols nil))
+ (do ((elm (element s) (element s)))
+ ((eq elm end))
+ (push elm cols))
+ (push (reverse cols) rows)))))
+ (if (streamp in)
+ (getit in)
+ (with-open-file (in in :direction :input)
+ (getit in))))
+ (convert (reverse rows) class)))
Modified: src/linalg/level3-linalg-generic.lisp
==============================================================================
--- src/linalg/level3-linalg-generic.lisp (original)
+++ src/linalg/level3-linalg-generic.lisp Sat Sep 26 14:26:49 2009
@@ -47,6 +47,9 @@
(.* (mref a i k) (mref b k j)))))))
c))
+(defmethod m/ ((a matrix-base) (b matrix-base))
+ (m* a (minv b)))
+
(defmethod minv ((a matrix-base))
(minv! (copy a)))
Modified: src/test/test-methods.lisp
==============================================================================
--- src/test/test-methods.lisp (original)
+++ src/test/test-methods.lisp Sat Sep 26 14:26:49 2009
@@ -24,7 +24,7 @@
(c %i)
(x (dmat (1 2) (3 4)))
(y (zmat (1 2) (3 4)))
- (w (mat 'matrix-ge (1 2) (3 4)))
+ (w (mmat 'matrix-ge (1 2) (3 4)))
(args (list a b c x y w)))
(mapc (lambda (fun)
(mapc (lambda (x)
@@ -99,7 +99,7 @@
(b (zmat (1 2) (3 5)))
(c (dmat (1 2 -1) (3 4 9) (1 1 1)))
(d (zmat (1 2 2.1) (3 5 %i) (-%i %i -%i)))
- (x (mat 'matrix-ge (1 2 2.1) (3 5 %i) (-%i %i -%i)))
+ (x (mmat 'matrix-ge (1 2 2.1) (3 5 %i) (-%i %i -%i)))
(args (list a b c d x)))
(mapc (lambda (x) (simple-non-nil-check #'mtp (list x))) args)
(mapc (lambda (x) (simple-non-nil-check #'mct (list x))) args)
More information about the lisplab-cvs
mailing list