[lisplab-cvs] r91 - src/matrix

[Jørn Inge Vestgården]

Author: jivestgarden
Date: Tue Sep  1 06:57:49 2009
New Revision: 91

Log:
new function map-into

Modified:
   package.lisp
   src/matrix/level2-generic.lisp
   src/matrix/level2-interface.lisp
   src/matrix/level2-matrix-dge.lisp
   src/matrix/level2-matrix-zge.lisp

Modified: package.lisp
==============================================================================
--- package.lisp	(original)
+++ package.lisp	Tue Sep  1 06:57:49 2009
@@ -163,7 +163,8 @@
    "MCREATE"
    "COPY-CONTENTS" 
    
-   "MMAP" 
+   "MMAP"   
+   "MMAP-INTO"
    "MFILL"
    "TO-VECTOR"
    "TO-MATRIX"

Modified: src/matrix/level2-generic.lisp
==============================================================================
--- src/matrix/level2-generic.lisp	(original)
+++ src/matrix/level2-generic.lisp	Tue Sep  1 06:57:49 2009
@@ -83,23 +83,24 @@
   (apply #'mmap (type-of a) f a args)) 
 
 (defmethod mmap ((type symbol) f (a matrix-base) &rest args)
-  (apply #'mmap (find-class type) f a args)) 
+  (apply #'mmap-into (make-matrix-instance type (dim a) 0)  f a args)) 
 
-(defmethod mmap (type f (a matrix-base) &rest args)  
-  (let ((b (make-matrix-instance type (dim a) 0)))
-    (cond ((not args)
+;; TODO map of matrix desciptions
+
+(defmethod mmap-into ((b matrix-base) f (a matrix-base) &rest args)  
+  (cond ((not args)
+	 (dotimes (i (size a))
+	   (setf (vref b i) (funcall f (vref a i)))))
+	((not (cdr args))
+	 (let ((c (car args)))
 	   (dotimes (i (size a))
-	     (setf (vref b i) (funcall f (vref a i)))))
-	  ((not (cdr args))
-	   (let ((c (car args)))
-	     (dotimes (i (size a))
-	       (setf (vref b i) (funcall f (vref a i) (vref c i))))))
-	  (t (dotimes (i (size a))
-	       (setf (vref b i) (apply f (vref a i) 
-				       (mapcar (lambda (x) 
-						 (vref x i)) 
-					       args))))))
-    b))
+	     (setf (vref b i) (funcall f (vref a i) (vref c i))))))
+	(t (dotimes (i (size a))
+	     (setf (vref b i) (apply f (vref a i) 
+				     (mapcar (lambda (x) 
+					       (vref x i)) 
+					     args))))))
+  b)
 
 (defmethod msum ((m matrix-base))
   "Sums all elements of m."

Modified: src/matrix/level2-interface.lisp
==============================================================================
--- src/matrix/level2-interface.lisp	(original)
+++ src/matrix/level2-interface.lisp	Tue Sep  1 06:57:49 2009
@@ -119,6 +119,9 @@
   (:documentation "Generalization of map, where type = t gives output 
 type equals type of m."))
 
+(defgeneric mmap-into (result f m &rest args)
+  (:documentation "Generalization of map-into."))
+
 (defgeneric mfill (a value)
   (:documentation "Sets each element to the value. Destructive"))
 

Modified: src/matrix/level2-matrix-dge.lisp
==============================================================================
--- src/matrix/level2-matrix-dge.lisp	(original)
+++ src/matrix/level2-matrix-dge.lisp	Tue Sep  1 06:57:49 2009
@@ -31,15 +31,13 @@
 		 :rows (rows matrix)
 		 :cols (cols matrix)))
 
-(defmethod mmap ((type matrix-base-dge) f (a matrix-base-dge) &rest args)
-  (let ((b (copy a)))
-    (apply #'map-into 
-	   (matrix-store b) 
-	   (lambda (&rest args)
-	     (coerce (apply f args) 'double-float))
-	   (matrix-store a) (mapcar #'matrix-store args))
-    b))
-
+(defmethod mmap-into ((out matrix-base-dge) f (a matrix-base-dge) &rest args)
+  (apply #'map-into 
+	 (matrix-store out)
+	 (lambda (&rest args)
+	   (coerce (apply f args) 'double-float))
+	 (matrix-store a) (mapcar #'matrix-store args))
+    out)
 
 (defmethod msum ((m matrix-base-dge))
   (let ((sum 0.0)

Modified: src/matrix/level2-matrix-zge.lisp
==============================================================================
--- src/matrix/level2-matrix-zge.lisp	(original)
+++ src/matrix/level2-matrix-zge.lisp	Tue Sep  1 06:57:49 2009
@@ -32,6 +32,18 @@
 		 :rows (rows matrix)
 		 :cols (cols matrix)))
 
+(defmethod copy-contents ((from matrix-base-dge) (to matrix-base-zge) &optional (converter nil))
+  (if converter 
+      (call-next-method) ;; Could have some testes here to improve performance
+      (let* ((store-a (matrix-store from))
+	     (store-b (matrix-store to))
+	     (len (length store-a)))
+	(declare (type type-blas-store store-a store-b)
+		 (type type-blas-idx len))
+	(dotimes (i len)
+	  (setf (aref store-b (* 2 i)) (aref store-a i)))
+	to))) 
+
 (defmethod msum ((m matrix-base-zge))
   (let ((sum-r 0.0)
         (sum-i 0.0)