From ada02b061aac7cbbf43145beaf5d27d78f9e9fcc Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola <nikodemus@random-state.net> Date: Mon, 8 Mar 2010 10:46:37 +0200 Subject: [PATCH] faster WHICHEVER Call RANDOM just once, and build an inline binary search tree for O(log n) goodness instead of O(n). Patch by: Gustavo <gugamilare@gmail.com> --- control-flow.lisp | 23 ++++++++++++++--------- 1 file changed, 14 insertions(+), 9 deletions(-) diff --git a/control-flow.lisp b/control-flow.lisp index 42a88f9..bf64728 100644 --- a/control-flow.lisp +++ b/control-flow.lisp @@ -52,15 +52,20 @@ returns the values of DEFAULT if no keys match." (setf possibilities (mapcar (lambda (p) (macroexpand p env)) possibilities)) (if (every (lambda (p) (constantp p)) possibilities) `(svref (load-time-value (vector ,@possibilities)) (random ,(length possibilities))) - (with-gensyms (function) - `(let ((,function (lambda () ,(pop possibilities)))) - (declare (function ,function)) - ,@(let ((p 1)) - (mapcar (lambda (possibility) - `(when (zerop (random ,(incf p))) - (setf ,function (lambda () ,possibility)))) - possibilities)) - (funcall ,function))))) + (labels ((expand (possibilities position random-number) + (if (null (cdr possibilities)) + (car possibilities) + (let* ((length (length possibilities)) + (half (truncate length 2)) + (second-half (nthcdr half possibilities)) + (first-half (butlast possibilities (- length half)))) + `(if (< ,random-number ,(+ position half)) + ,(expand first-half position random-number) + ,(expand second-half (+ position half) random-number)))))) + (with-gensyms (random-number) + (let ((length (length possibilities))) + `(let ((,random-number (random ,length))) + ,(expand possibilities 0 random-number))))))) (defmacro xor (&rest datums) "Evaluates its argument one at a time, from left to right. If more then one -- GitLab