[lisplab-cvs] r43 - in src: core linalg matrix

[Jørn Inge Vestgården]

Author: jivestgarden
Date: Sun May 24 11:09:27 2009
New Revision: 43

Log:
bugfix

Modified:
   src/core/level0-functions.lisp
   src/core/level0-generic.lisp
   src/linalg/level3-linalg-generic.lisp
   src/matrix/level2-constructors.lisp

Modified: src/core/level0-functions.lisp
==============================================================================
--- src/core/level0-functions.lisp	(original)
+++ src/core/level0-functions.lisp	Sun May 24 11:09:27 2009
@@ -18,6 +18,44 @@
 
 (in-package :lisplab)
 
+(export '(.+ .* ./ .- .^ ^))
+
+(defmethod matrix? ((a number)) nil)
+
+(defmethod vector? ((a number)) nil)
+
+(defmethod scalar? ((a number)) t)
+
+(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 .abs ((a number))
   (abs a))
 

Modified: src/core/level0-generic.lisp
==============================================================================
--- src/core/level0-generic.lisp	(original)
+++ src/core/level0-generic.lisp	Sun May 24 11:09:27 2009
@@ -19,42 +19,4 @@
 
 (in-package :lisplab)
 
-(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))
-
+;; TODO delete file
\ No newline at end of file

Modified: src/linalg/level3-linalg-generic.lisp
==============================================================================
--- src/linalg/level3-linalg-generic.lisp	(original)
+++ src/linalg/level3-linalg-generic.lisp	Sun May 24 11:09:27 2009
@@ -36,7 +36,7 @@
     b))
 
 (defmethod mct ((a matrix-base))
-  (mconj (mtp a)))
+  (.conj (mtp a)))
 
 (defmethod m* ((a matrix-base) (b matrix-base))
   (let ((c (mcreate a 0 (list (rows a) (cols b)))))
@@ -136,35 +136,32 @@
 	(setf (mref Pmat i (vref p i) ) 1))
       (list L U Pmat))))
 
-(defun L-solve! (L x w/diag)
-  ;; Solve Lx=b
-  (setf (vref x 0) (./ (vref x 0) 
-		       (if w/diag (mref L 0 0) 1)))
+(defun L-solve! (L x)
+  ;; Solves Lx=b
   (loop for i from 1 below (size x) do
        (let ((sum (vref x i)))
 	 (loop for j from 0 below i do
 	      (setf sum (.- sum (.* (mref L i j) (vref x j)))))
-	 (setf (vref x i)  
-	       (./ sum 
-		   (if w/diag (mref L i i) 1)))))
+	 (setf (vref x i) sum))) 
   x)
 
-(defun U-solve! (U x w/diag)
+(defun U-solve! (U x)
+  ;; Solves Ux=b
   (let* ((N (size x))
 	 (N-1 (1- N)))
     (setf (vref x N-1) (./ (vref x N-1) 
-			   (if w/diag (mref U N-1 N-1) 1)))
+			   (mref U N-1 N-1)))
     (loop for i from (- N-1 1) downto 0 do
 	 (let ((sum (vref x i)))
 	   (loop for j from (1+ i) below N do
 		(setf sum (.- sum (.* (mref U i j) (vref x j)))))
 	   (setf (vref x i) (./ sum 
-				(if w/diag (mref U i i) 1)))))
+				(mref U i i)))))
       x))
 
 (defun LU-solve! (LU x)
-  (L-solve! LU x nil)
-  (U-solve! LU x t)
+  (L-solve! LU x)
+  (U-solve! LU x)
   x)
 
 (defmethod lin-solve ((A matrix-base) (b matrix-base))

Modified: src/matrix/level2-constructors.lisp
==============================================================================
--- src/matrix/level2-constructors.lisp	(original)
+++ src/matrix/level2-constructors.lisp	Sun May 24 11:09:27 2009
@@ -25,6 +25,12 @@
 	  dmat dnew dcol drow
 	  zmat znew zcol zrow))
 
+(defmethod copy ((a matrix-base))
+  (let ((x (make-matrix-instance (class-of a) (dim a) 0)))
+    (dotimes (i (size x))
+      (setf (vref x i) (vref a i)))
+    x))
+
 (defmethod mcreate ((a matrix-base) &optional (value 0) dim)
   (unless dim
     (setf dim (dim a)))