[lisplab-cvs] r208 - trunk/src/linalg

[jivestgarden at common-lisp.net]

Author: jivestgarden
Date: Sun Mar 18 08:14:21 2012
New Revision: 208

Log:
Implemented mtp and optimized m*

Modified:
   trunk/src/linalg/level3-linalg-dge.lisp

Modified: trunk/src/linalg/level3-linalg-dge.lisp
==============================================================================
--- trunk/src/linalg/level3-linalg-dge.lisp	Sun Oct  9 08:06:36 2011	(r207)
+++ trunk/src/linalg/level3-linalg-dge.lisp	Sun Mar 18 08:14:21 2012	(r208)
@@ -25,27 +25,35 @@
       (setf ans (.+ ans (mref matrix i i))))
     ans))
 
-#+todo (defmethod mtp (a)
-  (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 mtp ((a matrix-base-dge))
+  (let* ((N (rows a))
+	 (M (cols a))
+	 (c (mcreate a 0 (list M N)))
+	 (a2 (vector-store a))
+	 (c2 (vector-store c)))
+    (declare (type-blas-store a2 c2)
+             (type-blas-idx M N))
+    (macrolet ((refa (i j) `(ref-blas-real-store A2 ,i ,j N))
+	       (refc (i j) `(ref-blas-real-store C2 ,i ,j M)))
+      (dotimes (i M)
+	(dotimes (j N)
+	  (setf (refc i j) (refa j i)))))
+    c))
 
 (defmethod mct ((a matrix-base-dge))
   (mtp a))
 
-(defmethod m* ((a matrix-base-dge) (b matrix-base-dge))
+(defmethod 2m* ((a matrix-base-dge) (b matrix-base-dge))
   (let* ((N (rows a))
 	 (M (cols b))
 	 (S (rows b))
 	 (c (mcreate a 0 (list N M)))
-	 (a2 (vector-store a))
+	 (a2 (vector-store (mtp a))) ; optimization. consideres the transpose
 	 (b2 (vector-store b))
 	 (c2 (vector-store c)))
     (declare (type-blas-store a2 b2 c2)
              (type-blas-idx N M S))
-    (macrolet ((refa (i j) `(ref-blas-real-store A2 ,i ,j N))
+    (macrolet ((refa (i j) `(ref-blas-real-store A2 ,j ,i N))
 	       (refb (i j) `(ref-blas-real-store B2 ,i ,j S))
 	       (refc (i j) `(ref-blas-real-store C2 ,i ,j N)))
       (dotimes (i N)