April 6, 2008

Sequence shuffling revisited

In my post “Trivial Sequence Shuffling” from yesterday I showed a simple hack to shuffle a sequence.

For your convenience:

(defun seqrnd (seq)
  "Randomize the elements of a sequence. Destructive on SEQ."
  (sort seq #'> :key (lambda (x) (random 1.0))))

The only downside to this algorithm, I claimed, is its complexity, which is worse than that of a specialized sorting algorithm.

However that is not the only problem with it. The ensuing discussion (thanks for your comments, guys!) showed that I didn’t notice an allowance made by the standard: the :KEY function might be called more than once, and implementations seem to make use of this. And while it is allowed to return different keys for the same element (i.e. let the :KEY function be not a proper function, but a plain relation), the result will not be a discrete uniform random distribution, but a biased distribution depending on the intricacies of the sorting procedure.

In this post I’d like to show the alternatives proposed and my own amendment, which extends my original flawed solution.

Peter de Wachter proposed:

(defun better-shuffle (seq)
  (let ((tagged (mapcar (lambda (x) (cons (random 1.0) x)) seq)))
    (mapcar 'cdr (sort tagged #'> :key 'car))))

It’s not that I don’t like it at all (after all it’s a nice case study in functional programming!), but I’m allergic to the consing it produces. I also feel that it overcomplicates things.

Paul Khuong wrote something similar which looks a bit more elegant to me:

(defun random-shuffle (sequence)
  (map-into sequence #'car
            (sort (map 'vector (lambda (x)
                                 (cons x (random 1d0)))
                       sequence)
                  #'< :key #'cdr)))

The other approach (in Scheme) came from Phil Bewig (hope I got the indent right):

(define (shuffle x)
  (do ((v (list->vector x)) (n (length x) (- n 1)))
    ((zero? n) (vector->list v))
    (let* ((r (random n)) (t (vector-ref v r)))
      (vector-set! v r (vector-ref v (- n 1)))
      (vector-set! v (- n 1) t))))

Ah, sorry Phil, but that's not my kind of style :) Too much imperative stuff here, a data conversion and a DO loop. Somehow the name of Rube Goldberg comes to my mind...

The <Good Solution> (alluding to Mark Tarver's Qi blurb) involves a thing as natural as anything to a Lisp (and I include Scheme here) programmer: memoization.

While memoization, i.e. caching function results, is most often used in a performance context, we might also apply it here to make our function always return the same result for an object, thus imposing a total ordering on the list:

(defvar *random-id-ht* nil)
 
(defun initialize-memo ()
  (setf *random-id-ht* (make-hash-table :test #'eq)))
 
(defun consistent-random-id (obj)
  (multiple-value-bind (val found-p) (gethash obj *random-id-ht*)
    (if found-p val
      (setf (gethash obj *random-id-ht*)
            (random 1.0)))))
 
(defun seqrnd (seq)
  "Randomize the elements of a sequence. Destructive on SEQ."
  (initialize-memo) ; need to clear between runs
  (sort seq #'> :key (lambda (x) (consistent-random-id x))))

This is a scaled down version of a memoizer; you probably don't want to do this at home. A generalized memoizer takes about two screenfuls (talking 24 lines here). You can find generalized memoizers everywhere on the net, for example in the Cells utility library for Common Lisp.

One might argue that this solution is too complicated. I hold against that that memoization should be present in every serious functional programmer's toolbox, so it boils down to the function itself -- which is only marginally longer than the first attempt.

April 06th 2008 Posted to Lisp,Programming

* Comments(11)

Comments

  1. Christophe Rhodes
    April 6th, 2008 | 11:54 am

    Your new seqrnd function will fail to randomize properly lists with duplicate elements in them.

    (Also, saying that you’re allergic to consing and then using a hash table for each run is pretty inconsistent. Have you measured the consing for your solution?)

  2. Leslie
    April 6th, 2008 | 12:05 pm

    Christophe: indeed, it should be an EQ hash table. Fixed.

    I didn’t benchmark the consing (yet), but I’m positive the hash table will be faster; I’ll check this later.

  3. Christophe Rhodes
    April 6th, 2008 | 12:37 pm

    No, an EQ hash table does not fix your problem.

    Test cases:

    (seqrnd (list 1 1 1 2 3))

    (let ((x “foo”))
    (seqrnd (list x x x 3 x)))

  4. Leslie
    April 6th, 2008 | 12:40 pm

    Here are the results, comparing Paul Khuong’s RANDOM-SHUFFLE with SEQRND.

    (defun benchmark (fn)
 (dotimes (x 1000)
   (let ((seq (loop for i from 1 to 1000 collect (random i))))
     (funcall fn seq))))
 
(time (benchmark #'random-shuffle))
(time (benchmark #'seqrnd))
    CLISP 2.41 (interpreted):

Real time: 25.72314 sec.
Run time: 10.665971 sec.
Space: 86264000 Bytes
GC: 164, GC time: 0.669959 sec.

Real time: 72.53122 sec.
Run time: 29.028109 sec.
Space: 79356432 Bytes
GC: 152, GC time: 0.5233 sec.

Bottom line: RANDOM-SHUFFLE 3x faster, SEQRND slightly less space.

    CLISP 2.41 (compiled)

Real time: 19.819485 sec.
Run time: 8.232797 sec.
Space: 86016072 Bytes
GC: 164, GC time: 0.663291 sec.

Real time: 28.287846 sec.
Run time: 10.196001 sec.
Space: 79108984 Bytes
GC: 151, GC time: 0.519969 sec.

Bottom line: RANDOM-SHUFFLE 1.35x faster, SEQRND slightly less space.

    SBCL 1.0.15:

Evaluation took:
  13.861 seconds of real time
  5.013006 seconds of user run time
  0.126658 seconds of system run time
  [Run times include 0.074 seconds GC run time.]
  0 calls to %EVAL
  0 page faults and
  52,039,552 bytes consed.

Evaluation took:
  4.639 seconds of real time
  2.263186 seconds of user run time
  0.026665 seconds of system run time
  [Run times include 0.009 seconds GC run time.]
  0 calls to %EVAL
  0 page faults and
  30,302,776 bytes consed.

Bottom line: SEQRND 3x faster, SEQRND 3/5 space.
  5. Phil Bewig
    April 6th, 2008 | 1:27 pm

    I raised the question of how to shuffle a list in comp.lang.scheme in May 2002. The imperative solution that I posted in response to your previous blog entry follows Knuth’s method for shuffling a vector, and is O(n). Any method involving sorting will be O(n log n), but for practical purposes the constant factors will probably defeat the asymptotic bounds. The most functional-looking shuffle came from Joe Marshall; it partitions the list into two pieces deterministically, shuffles them recursively, then merges them back together randomly:

    (define (shuffle xs)
  (if (or (null? xs) (null? (cdr xs))) xs
      (let split ((xs xs) (odd '()) (even '()))
        (if (pair? xs)
            (split (cdr xs) (cons (car xs) even) odd)
            (let merge ((odd (shuffle odd)) (even (shuffle even)))
              (cond ((null? odd) even)
                    ((null? even) odd)
                    ((zero? (random 2)) (cons (car odd) (merge (cdr odd) even)))
                    (else (cons (car even) (merge odd (cdr even))))))))))

    A faster functional shuffle comes from Al Petrofsky; it first partitions the list randomly, then merges the two pieces back together randomly:

    (define (shuffle xs)
  (let shuffle ((xs xs) (acc '()))
    (if (null? xs) acc
        (if (null? (cdr xs)) (cons (car xs) acc)
            (let split ((xs xs) (x1 '()) (x2 '()))
              (if (null? xs)
                  (if (null? x1)
                      (split x2 '() '())
                      (shuffle x1 (shuffle x2 acc)))
                  (if (zero? (random 2))
                      (split (cdr xs) (cons (car xs) x1) x2)
                      (split (cdr xs) x1 (cons (car xs) x2)))))))))

    If you speak Haskell, Oleg Kiselyov presented a perfect shuffle of complexity O(n log n) in comp.lang.functional in September 2001. I won’t quote it here, because the implementation only makes sense if you read the accompanying derivation.

  6. Phil Bewig
    April 6th, 2008 | 1:29 pm

    What’s the trick to make the code indent properly?

  7. Leslie
    April 6th, 2008 | 1:43 pm

    Use <pre lang=”lisp”>CODE</pre>

  8. Leslie
    April 6th, 2008 | 2:43 pm

    Christophe: I can’t think of a way to fix the problem with literals. Do you?

    It would be really nice to do this with memoizing.
    But having it working except for literals is already a nice thing.

  9. foo
    April 6th, 2008 | 4:18 pm

    Don’t set the global variable. Use LET to bind a value to it.

  10. Leslie
    April 6th, 2008 | 4:28 pm

    foo: what are you referring to?

  11. Christophe Rhodes
    April 6th, 2008 | 6:44 pm

    It’s not a problem with literals; it’s a problem with duplicate entries.

    What I imagine “foo” is referring to is that your function isn’t thread-safe, because the binding for seqrnd is shared amongst all threads. (seqrnd is also not re-entrant: if you end up in the debugger, for example, and call seqrnd from there, you will destroy the current execution’s state.)

    To fix these problems, use one of the correct solutions that you are “allergic” to.

Leave a reply