[lisplab-cvs] r177 - in trunk: . src/matrix

Jørn Inge Vestgården jivestgarden at common-lisp.net
Thu Jun 3 18:08:15 UTC 2010


Author: jivestgarden
Date: Thu Jun  3 14:08:14 2010
New Revision: 177

Log:
max,min, etc. now return also the index

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

Modified: trunk/package.lisp
==============================================================================
--- trunk/package.lisp	(original)
+++ trunk/package.lisp	Thu Jun  3 14:08:14 2010
@@ -196,6 +196,7 @@
    "MMAX" 
    "MABSMIN" 
    "MABSMAX"
+   "MMINMAX"
    "ROW-SWAP!"
    "ROW-MUL!"
    "ROW-ADD!"

Modified: trunk/src/matrix/level2-generic.lisp
==============================================================================
--- trunk/src/matrix/level2-generic.lisp	(original)
+++ trunk/src/matrix/level2-generic.lisp	Thu Jun  3 14:08:14 2010
@@ -126,46 +126,48 @@
   b)
 
 (defmethod msum ((m matrix-base))
-  "Sums all elements of m."
   (let ((sum 0))
     (dotimes (i (size m))
       (setf sum (.+ sum (vref m i))))
     sum))
 
 (defmethod mmax ((m matrix-base))
-  "Retuns the maximum element of m."
-  (let ((max (vref m 0)))
+  (let ((max (vref m 0))
+	(idx 0))
     (dotimes (i (size m))
       (when (.> (vref m i) max)
-	(setf max (vref m i))))
-    max))
+	(setf max (vref m i)
+	      idx i)))
+    (values max idx)))
 
 (defmethod mmin ((m matrix-base))
-  "Retuns the minimum element of m."
-  (let ((min (vref m 0)))
+  (let ((min (vref m 0))
+	(idx 0))
     (dotimes (i (size m))
       (when (.< (vref m i) min)
-	(setf min (vref m i))))
-    min))
+	(setf min (vref m i)
+	      idx i)))
+    (values min idx)))
 
 (defmethod mabsmax ((m matrix-base))
-  "Retuns the element of m with highes absolute value."
-  (let ((max (vref m 0)))
+  (let ((max (vref m 0))
+	(idx 0))
     (dotimes (i (size m))
       (when (.> (abs (vref m i)) (abs max))
-	(setf max (vref m i))))
-    max))
+	(setf max (vref m i)
+	      idx i)))
+    (values max idx)))
 
 (defmethod mabsmin ((m matrix-base))
-  "Retuns the element of m with smallest absolute value."
-  (let ((min (vref m 0)))
+  (let ((min (vref m 0))
+	(idx 0))	  
     (dotimes (i (size m))
       (when (.< (abs (vref m i)) (abs min))
-	(setf min (vref m i))))
-    min))
+	(setf min (vref m i)
+	      idx i)))
+    (values min idx)))
 
 (defmethod mminmax ((m matrix-base))
-  "Retuns the maximum element of m."
   (let ((max (vref m 0))
 	(min (vref m 0)))    
     (dotimes (i (size m))

Modified: trunk/src/matrix/level2-interface.lisp
==============================================================================
--- trunk/src/matrix/level2-interface.lisp	(original)
+++ trunk/src/matrix/level2-interface.lisp	Thu Jun  3 14:08:14 2010
@@ -130,19 +130,19 @@
 ;;; Helpers
 
 (defgeneric msum (m)
-  (:documentation "Sums all matrix elements"))
+  (:documentation "Sums all matrix elements."))
 
 (defgeneric mmin (m)
-  (:documentation "Retuns the smalles matrix element"))
+  (:documentation "Retuns the smalles matrix element and its vector index."))
 
 (defgeneric mmax (m)
-  (:documentation "Retuns the largest matrix element"))
+  (:documentation "Retuns the largest matrix element and its vector index."))
 
 (defgeneric mabsmin (m)
-  (:documentation "Retuns the matrix element closest to zero"))
+  (:documentation "Retuns the matrix element closest to zero and its vector index."))
 
 (defgeneric mabsmax (m)
-  (:documentation "Retuns the matrix element with largest absolute value"))
+  (:documentation "Retuns the matrix element with largest absolute value and its vector index."))
 
 (defgeneric mminmax (m)
   (:documentation "Retuns a list with (minumum maximum)"))

Modified: trunk/src/matrix/level2-matrix-dge.lisp
==============================================================================
--- trunk/src/matrix/level2-matrix-dge.lisp	(original)
+++ trunk/src/matrix/level2-matrix-dge.lisp	Thu Jun  3 14:08:14 2010
@@ -75,62 +75,69 @@
     sum))
 
 (defmethod mmax ((m matrix-base-dge))
-  "Retuns the minimum element of m."
   (let* ((store (matrix-store m))
-	 (max (aref store 0)))
+	 (max (aref store 0))
+	 (idx 0))
     (declare (type type-blas-store store)
-	     (type double-float max))
+	     (type double-float max)
+	     (type type-blas-idx idx))
     (dotimes (i (length store))
       (when (> (aref store i) max)
-	(setf max (aref store i))))
-    max))
+	(setf max (aref store i)
+	      idx i)))
+    (values max idx)))
 
 (defmethod mmin ((m matrix-base-dge))
-  "Retuns the minimum element of m."
   (let* ((store (matrix-store m))
-	 (min (aref store 0)))
+	 (min (aref store 0))
+	 (idx 0))
     (declare (type type-blas-store store)
-	     (type double-float min))
+	     (type double-float min)
+	     (type type-blas-idx idx))
     (dotimes (i (length store))
       (when (< (aref store i) min)
-	(setf min (aref store i))))
-    min))
+	(setf min (aref store i)
+	      idx i)))
+    (values min idx)))
 
-(defmethod mminmax ((m matrix-base-dge))
-  "Retuns the minimum element of m."
+(defmethod mabsmax ((m matrix-base-dge))
   (let* ((store (matrix-store m))
 	 (max (aref store 0))
-	 (min (aref store 0)))
+	 (idx 0))
     (declare (type type-blas-store store)
-	     (type double-float max min))
+	     (type double-float max)
+	     (type type-blas-idx idx))
     (dotimes (i (length store))
-      (when (> (aref store i) max)
-	(setf max (aref store i)))
-      (when (< (aref store i) min)
-	(setf min (aref store i))))      
-    (list min max)))
+      (when (> (abs (aref store i)) (abs max))
+	(setf max (aref store i)
+	      idx i)))
+    (values max idx)))
 
-(defmethod mabsmax ((m matrix-base-dge))
-  "Retuns the minimum element of m."
+(defmethod mabsmin ((m matrix-base-dge))
   (let* ((store (matrix-store m))
-	 (max (aref store 0)))
+	 (min (aref store 0))
+	 (idx 0))
     (declare (type type-blas-store store)
-	     (type double-float max))
+	     (type double-float min)
+	     (type type-blas-idx idx))
     (dotimes (i (length store))
-      (when (> (abs (aref store i)) (abs max))
-	(setf max (aref store i))))
-    max))
+      (when (< (abs (aref store i)) (abs min))
+	(setf min (aref store i)
+	      idx i)))
+    (values min idx)))
 
-(defmethod mabsmin ((m matrix-base-dge))
-  "Retuns the minimum element of m."
+(defmethod mminmax ((m matrix-base-dge))
   (let* ((store (matrix-store m))
+	 (max (aref store 0))
 	 (min (aref store 0)))
     (declare (type type-blas-store store)
-	     (type double-float min))
+	     (type double-float max min))
     (dotimes (i (length store))
-      (when (< (abs (aref store i)) (abs min))
-	(setf min (aref store i))))
-    min))
+      (when (> (aref store i) max)
+	(setf max (aref store i)))
+      (when (< (aref store i) min)
+	(setf min (aref store i))))      
+    (list min max)))
 
 (defmethod .some (pred (a matrix-base-dge) &rest args)
   (let ((stores (mapcar #'matrix-store (cons a args))))




More information about the lisplab-cvs mailing list