[cl-utilities-cvs] CVS update: cl-utilities/extremum.lisp

[Peter Scott]

Update of /project/cl-utilities/cvsroot/cl-utilities
In directory common-lisp.net:/tmp/cvs-serv18708

Modified Files:
	extremum.lisp 
Log Message:
Improved efficiency some. Added EXTREMUM-FASTKEY which uses a
different, and sometimes faster, algorithm.

Date: Thu May 12 23:17:23 2005
Author: pscott

Index: cl-utilities/extremum.lisp
diff -u cl-utilities/extremum.lisp:1.1.1.1 cl-utilities/extremum.lisp:1.2
--- cl-utilities/extremum.lisp:1.1.1.1	Mon May  9 23:26:29 2005
+++ cl-utilities/extremum.lisp	Thu May 12 23:17:23 2005
@@ -13,6 +13,15 @@
                     a
                     b)))
 
+(defun zero-length-p (sequence)
+  "Is the length of SEQUENCE equal to zero?"
+  (declare (optimize (speed 3) (safety 0) (space 0) (debug 1)))
+  (or (null sequence)
+      (when (vectorp sequence)
+	(zerop (length sequence)))))
+
+(declaim (inline zero-length-p))
+
 ;; This is an extended version which takes START and END keyword
 ;; arguments. Any spec-compliant use of EXTREMUM will also work with
 ;; this extended version.
@@ -23,7 +32,7 @@
 http://www.cliki.net/EXTREMUM for the full
 specification. Additionally, START and END specify the beginning and
 ending indices of the part of the sequence we should look at."
-  (if (= 0 (length sequence))
+  (if (zero-length-p sequence)
       (restart-case (error 'no-extremum)
 	(continue ()
 	  :report "Return NIL instead"
@@ -37,9 +46,44 @@
   "Returns the element of SEQUENCE that would appear first if the
 sequence were ordered according to SORT using PREDICATE and KEY. See
 http://www.cliki.net/EXTREMUM for the full specification."
-  (if (= 0 (length sequence))
+  (if (zero-length-p sequence)
+      (restart-case (error 'no-extremum)
+	(continue ()
+	  :report "Return NIL instead"
+	  nil))
+      (reduce (comparator predicate key) sequence)))
+
+;; This is an "optimized" version which calls KEY less. REDUCE is
+;; already so optimized that this will actually be slower unless KEY
+;; is expensive. And on CLISP, of course, the regular version will be
+;; much faster since built-in functions are ridiculously faster than
+;; ones implemented in Lisp. Be warned, this isn't as carefully tested
+;; as regular EXTREMUM and there's more that could go wrong.
+(defun extremum-fastkey (sequence predicate
+			 &key (key #'identity) (start 0) end)
+  "EXTREMUM implemented so that it calls KEY less. This is only faster
+if the KEY function is so slow that calling it less often would be a
+significant improvement; ordinarily it's slower."
+  (declare (optimize (speed 3) (safety 0) (space 0) (debug 1)))
+  (if (zero-length-p sequence)
       (restart-case (error 'no-extremum)
 	(continue ()
 	  :report "Return NIL instead"
 	  nil))
-      (reduce (comparator predicate key) sequence)))
\ No newline at end of file
+      (let* ((smallest (elt sequence 0))
+	     (smallest-key (funcall key smallest))
+	     (current-index 0)
+	     (real-end (or end #.(1- most-positive-fixnum))))
+	(declare (type (integer 0 #.most-positive-fixnum)
+		       current-index real-end start))
+	(map nil #'(lambda (x)
+		     (when (<= start current-index real-end)
+		       (let ((x-key (funcall key x)))
+			 (when (funcall predicate
+					x-key
+					smallest-key)
+			   (setf smallest x)
+			   (setf smallest-key x-key))))
+		     (incf current-index))
+	     sequence)
+	smallest)))
\ No newline at end of file