Updating VECTOR= performance.

ChangeLog

@@ -1,3 +1,8 @@
+2010-04-12  Rudy Neeser  <rudy.neeser@gmail.com>
+
+	* vector.lisp (vector=): Performed some optimisations to make
+	vector comparision quicker.
+
 2010-04-06  Rudy Neeser  <rudy.neeser@gmail.com>
 
 	* random.lisp (uniform): Added a method to create uniformly

vector.lisp

@@ -210,23 +210,40 @@
 (defgeneric vector= (lhs rhs)
   (:documentation "Returns t iff the two vectors are equal. Effected
   by *equivalence-tolerance*.")
-  (:method (lhs rhs)
-    (declare (type (or vector list) lhs rhs))
-    (symbol-macrolet ((lhs-data (if (listp lhs)
-				    lhs
-				    (slot-value lhs 'data)))
-		      (rhs-data (if (listp rhs)
-				    rhs
-				    (slot-value rhs 'data))))
-      (cond
-	((/= (cl:length lhs-data) (cl:length rhs-data))
-	 nil)
-	(t
-	 (if (/= *equivalence-tolerance* 0)
-	     (every #'(lambda (x y)
-			(<= (abs (- x y)) *equivalence-tolerance*))
-		    lhs-data rhs-data)
-	     (every #'= lhs-data rhs-data)))))))
+  (:method ((lhs vector) (rhs vector))
+    (with-slots ((lhs-data data)) lhs
+      (with-slots ((rhs-data data)) rhs
+	(cond
+	  ((/= (cl:length lhs-data) (cl:length rhs-data))
+	   nil)
+	  (t
+	   (if (/= *equivalence-tolerance* 0)
+	       (loop
+		  for x across lhs-data
+		  for y across rhs-data
+		  always
+		    (<= (abs (- x y)) *equivalence-tolerance*))
+	       (loop
+		  for x across lhs-data
+		  for y across rhs-data
+		  always (= x y)))))))))
+
+(defmethod vector= ((lhs list) (rhs list))
+  (cond
+    ((/= (cl:length lhs) (cl:length rhs))
+     nil)
+    (t
+     (if (/= *equivalence-tolerance* 0)
+	 (loop
+	    for x in lhs
+	    for y in rhs
+	    always (<= (abs (- x y)) *equivalence-tolerance*))
+	 (loop
+	    for x in lhs
+	    for y in rhs
+	    always (= x y))))))
+
+
 
 (defmethod equivalent ((lhs vector) (rhs vector))
   "Synonym for VECTOR=."
@@ -235,9 +252,7 @@
 (defmethod equivalent ((lhs list) (rhs list))
   "Returns t iff the two lists are of the same length with equivalent
 elements."
-  (and (= (length lhs)
-	  (length rhs))
-       (every #'equivalent lhs rhs)))
+  (vector= lhs rhs))
 
 (defmethod equivalent ((lhs list) (rhs vector))
   "Compares a list and a vector for equivalence."