[lisplab-cvs] r119 - src/matrix

Jørn Inge Vestgården jivestgarden at common-lisp.net
Sat Dec 12 19:48:02 UTC 2009


Author: jivestgarden
Date: Sat Dec 12 14:48:01 2009
New Revision: 119

Log:
optimized mmax mmin mabsmax mabsmin

Modified:
   src/matrix/level2-matrix-dge.lisp

Modified: src/matrix/level2-matrix-dge.lisp
==============================================================================
--- src/matrix/level2-matrix-dge.lisp	(original)
+++ src/matrix/level2-matrix-dge.lisp	Sat Dec 12 14:48:01 2009
@@ -69,6 +69,54 @@
       (incf sum x))
     sum))
 
+(defmethod mmax ((m matrix-base-dge))
+  "Retuns the minimum element of m."
+  (let* ((store (matrix-store m))
+	 (max (aref store 0)))
+    (declare (type type-blas-store store)
+	     (type double-float max))
+    (dotimes (i (length store))
+      (when (> (aref store i) max)
+	(setf max (aref store i))))
+    max))
+
+(defmethod mmin ((m matrix-base-dge))
+  "Retuns the minimum element of m."
+  (let* ((store (matrix-store m))
+	 (min (aref store 0)))
+    (declare (type type-blas-store store)
+	     (type double-float min))
+    (dotimes (i (length store))
+      (when (< (aref store i) min)
+	(setf min (aref store i))))
+    min))
+
+(defmethod mabsmax ((m matrix-base-dge))
+  "Retuns the minimum element of m."
+  (let* ((store (matrix-store m))
+	 (max (aref store 0)))
+    (declare (type type-blas-store store)
+	     (type double-float max))
+    (dotimes (i (length store))
+      (when (> (abs (aref store i)) (abs max))
+	(setf max (aref store i))))
+    max))
+
+(defmethod mabsmin ((m matrix-base-dge))
+  "Retuns the minimum element of m."
+  (let* ((store (matrix-store m))
+	 (min (aref store 0)))
+    (declare (type type-blas-store store)
+	     (type double-float min))
+    (dotimes (i (length store))
+      (when (< (abs (aref store i)) (abs min))
+	(setf min (aref store i))))
+    min))
+
+
+
+
+
 (defmethod .some (pred (a matrix-base-dge) &rest args)
   (let ((stores (mapcar #'matrix-store (cons a args))))
     (apply #'some pred stores)))




More information about the lisplab-cvs mailing list