[lisplab-cvs] r37 - in src: io linalg

[Jørn Inge Vestgården]

Author: jivestgarden
Date: Fri May 22 15:04:11 2009
New Revision: 37

Log:
Cleaned up

Modified:
   src/io/level3-io.lisp
   src/linalg/level3-linalg-generic.lisp

Modified: src/io/level3-io.lisp
==============================================================================
--- src/io/level3-io.lisp	(original)
+++ src/io/level3-io.lisp	Fri May 22 15:04:11 2009
@@ -111,7 +111,9 @@
 		(verbose nil)
 		(max (mmax m))
 		(min (mmin m)))
-  "Writes matrix as postscipt bitmap. Port of a2ps.c by Eric Weeks."
+  "Writes matrix as postsrcipt bitmap. Port of a2ps.c by Eric Weeks."
+  ;; TODO: clean up and some more lispifying.
+  ;; TODO: more testing.
   (let* ((DTXSCALE 1.0787)
 	 (DTYSCALE 1.0)
 	 (DTHRES 513)
@@ -120,12 +122,13 @@
 	 (YOFFSET 288) ; /* 4 inches.  */
 
 	 (nbits 8)
-	 (scale 0.5)
+	 (scale 1)
 	 (invert 0)
 	 (count 0)
-	 (title 0)
+	 (title nil)
 	 (xsc 1.0)
-	 (ysc 1.0)
+	 ; (ysc 1.0 )
+	 (ysc (/ (cols m) (rows m) 1.0))
 	 
 	 (xscale (floor (* DTXSCALE scale 432 xsc)))
 	 (yscale (floor (* DTYSCALE scale 432 ysc)))
@@ -135,14 +138,11 @@
 	 (hres (rows m))
 	 ; (vres DTVRES)
 	 (vres (cols m)))
-    ;; ? fscanf(fp,"%ld %ld",&hres,&vres);
-    
-    ;;  Write the necessary starting junk  
     (with-open-file (out filename :direction :output :if-exists :supersede)
-      (format out "\%!~%")  ;; Identifies job as Postscript.
-      (format out "\%\%BoundingBox ~A ~A ~A ~A~%" 0 0 xscale yscale)
+      (format out "\%!PS-Adobe-3.0 EPSF-3.0~%")  ;; Identifies job as Postscript.
+      (format out "\%\%BoundingBox: ~A ~A ~A ~A~%" xof yof (+ xscale xof) (+ yscale yof))
       (format out "gsave~%")
-      (when (= title 1)
+      (when title
 	(format out "/Times-Roman findfont 30 scalefont setfont~%")
 	(format out "50.0 50.0 moveto~%")
 	(format out "(~A) show~%" filename))

Modified: src/linalg/level3-linalg-generic.lisp
==============================================================================
--- src/linalg/level3-linalg-generic.lisp	(original)
+++ src/linalg/level3-linalg-generic.lisp	Fri May 22 15:04:11 2009
@@ -22,29 +22,30 @@
 
 (in-package :lisplab)
 
-(defmethod mtr (matrix)
+(defmethod mtr ((matrix matrix-base))
   (let ((ans 0))
     (dotimes (i (rows matrix))
       (setf ans (.+ ans (mref matrix i i))))
     ans))
 
-(defmethod mtp (a)
+(defmethod mtp ((a matrix-base))
   (let ((b (mcreate a 0 (list (cols a) (rows a)))))
     (dotimes (i (rows b))
       (dotimes (j (cols b))
 	(setf (mref b i j) (mref a j i))))
     b))
 
-(defmethod mconj (a)
+(defmethod mconj ((a matrix-base))
+  ;; TODO this should be .conj and be level0 
   (let ((b (mcreate a #C(0 0) (list (rows a) (cols a)) )))
     (dotimes (i (size b))
       (setf (vref b i) (conjugate (vref a i))))
     b))
 
-(defmethod mct (a)
+(defmethod mct ((a matrix-base))
   (mconj (mtp a)))
 
-(defmethod m* (a b)
+(defmethod m* ((a matrix-base) (b matrix-base))
   (let ((c (mcreate a 0 (list (rows a) (cols b)))))
     (dotimes (i (rows c))
       (dotimes (j (cols c))
@@ -53,10 +54,10 @@
 				 (.* (mref a i k) (mref b k j)))))))
     c))
 
-(defmethod minv (a)
+(defmethod minv ((a matrix-base))
   (minv! (copy a)))
 
-(defmethod minv! (a)
+(defmethod minv! ((a matrix-base))
   "Matrix inversion based on LU-factorization."
   (let ((LU (copy A)))
     (destructuring-bind (LU p det) 
@@ -68,7 +69,7 @@
 	  (LU-solve! LU col))))
     A))
       
-#+nil (defmethod minv! (a)
+#+nil (defmethod minv! ((a matrix-base))
   ;; Flawed. Does not work on when pivoting is needed
   "Brute force O(n^3) implementation of matrix inverse.
 Think I'll keep this for the general case since it works also 
@@ -89,11 +90,14 @@
 	    (setf (mref a j k)
 		  (.- (mref a j k) (.* temp (mref a i k))))))))))
 
-(defmethod LU-factor! (A p)
+(defmethod LU-factor! ((A matrix-base) p)
   ;; Translation from GSL. 
   ;; Destructive LU factorization. The outout is PA=LU,
   ;; stored in one matrix, where the diagonal elements belong
   ;; to U and L has implicite ones at diagonal.
+
+  ;; TODO: handle permutations better!
+
   ;; TODO: Change unatural i and j indexing.
   (let ((N (rows A))
 	(sign 1))
@@ -126,7 +130,7 @@
 				 (.* Aij (mref A j k)))))))))
     (list A p sign)))
 	  
-(defmethod LU-factor (A)
+(defmethod LU-factor ((A matrix-base))
   (destructuring-bind (A p sign)
       (LU-factor! (copy A)
 		  (make-permutation-vector (rows A)))
@@ -139,7 +143,7 @@
 	(setf (mref Pmat i (vref p i) ) 1))
       (list L U Pmat))))
 
-(defun L-solve! (L x w/diag)
+(defun L-solve! ((L matrix-base) (x matrix-base) w/diag)
   ;; Solve Lx=b
   (setf (vref x 0) (./ (vref x 0) 
 		       (if w/diag (mref L 0 0) 1)))
@@ -152,7 +156,7 @@
 		   (if w/diag (mref L i i) 1)))))
   x)
 
-(defun U-solve! (U x w/diag)
+(defun U-solve! ((U matrix-base) (x matrix-base) w/diag)
   (let* ((N (size x))
 	 (N-1 (1- N)))
     (setf (vref x N-1) (./ (vref x N-1) 
@@ -165,19 +169,19 @@
 				(if w/diag (mref U i i) 1)))))
       x))
 
-(defun LU-solve! (LU x)
+(defun LU-solve! ((LU matrix-base) (x matrix-base))
   (L-solve! LU x nil)
   (U-solve! LU x t)
   x)
 
-(defmethod lin-solve (A b)
+(defmethod lin-solve ((A matrix-base) (b matrix-base))
   (destructuring-bind (LU pvec sign) (LU-factor A)
     (let ((b2 (copy b)))
       (dotimes (i (rows A))
 	(setf (vref b2 (vref pvec i)) (vref b i)))
       (LU-solve! LU b2))))
   
-(defmethod mdet (A)
+(defmethod mdet ((A matrix-base))
   (destructuring-bind (LU pvec det) (LU-factor A)    
     (dotimes (i (rows A))
       (setf det (.* det (mref LU i i))))