[plt-scheme] Scheme implementation of Fisher-Yates shuffle

I asked for the best way to shuffle a list on comp.lang.scheme a few years
ago.  The discussion went wild; you can see it on Google Groups if you
want.  After that, I wrote this summary:

It is easy to shuffle a vector by stepping through the vector, swapping each
element with a forward element (including possibly the element itself) until
the next-to-last element is reached. The classic description is given by
Knuth in AoCP, Volume 2, Section 3.4.2, Algorithm P:

(define (shuffle v)
  (do ((n (length x) (- n 1))) ((zero? n) 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))))

 But shuffling a list is harder, because lists don't permit O(1) access to
any element except the first. Joe Marshall provides this method of shuffling
a list by partitioning it into two pieces deterministically, shuffling them
recursively, then merging them 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))))))))))

 Al Petrofsky proposes this somewhat faster code that first partitions the
list randomly, then randomly merges them:

(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 want, you can always do Perl's omigod Schwartzian transform:

(define (shuffle xs)
  (map cdr
    (sort (lambda (x y) (< (car x) (car y)))
      (map (lambda (x) (cons (random 1.0) x)) xs))))

 But the fastest method of shuffling a list is to convert it to a vector,
use Knuth's algorithm to shuffle the vector, then convert it back to a list;
this algorithm operates in linear time (all the others are n log n), and is
very fast despite the two type conversions:

(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))))



On Sun, Aug 9, 2009 at 12:39 PM, Jon Rafkind <rafkind at cs.utah.edu> wrote:

> Amit Saha wrote:
>
>> Hello all,
>>
>> Here is my Scheme implementation of the "modern" version of the "Fisher
>> Yates Shuffle" (http://en.wikipedia.org/wiki/Fisher%E2%80%93Yates_shuffle).
>> I am sharing this with the hope that it may be useful to someone in the
>> community.
>>
>> <code>
>> #lang scheme
>>
>> ;; Fisher-Yates shuffling algorithm in Scheme (plt-scheme)
>> ;; Amit Saha (http://amitksaha.wordpress.com; amitsaha.in at gmail.com)
>>
>> ;; Useful to obtain a random shuffle of a list
>> ;; call with (shuffle <your list>)
>>
>> (define (shuffle deck)
>>   (let loop ((n (length deck)) (shuff_deck (list->vector deck)))
>>     (if (<= n 1)
>>       shuff_deck
>>       (begin
>>     (set! n (- n 1))
>>     (let* ([rand (random (+ 1 n))]
>>           [tmp (vector-ref shuff_deck rand)]
>>          )
>>       (vector-set! shuff_deck rand (vector-ref shuff_deck n))
>>       (vector-set! shuff_deck n tmp))
>>       (loop n shuff_deck)))))
>> </code>
>>
>>  Heres the one I wrote a while ago
> (define (randomize lst)
>  (let ((v (list->vector lst)))
>   (let loop ((max (sub1 (vector-length v))))
>     (if (= 0 max)
>       (vector->list v)
>       (begin
>         (let ((place (random max)))
>           (let ((tmp (vector-ref v place)))
>             (vector-set! v place (vector-ref v max))
>             (vector-set! v max tmp)))
>         (loop (sub1 max)))))))
>
> Notable differences are I don't set! the index variable, nor do I pass
> along the vector in the loop. Otherwise I guess they are about the same.
>
> _________________________________________________
>  For list-related administrative tasks:
>  http://list.cs.brown.edu/mailman/listinfo/plt-scheme
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20090809/6216aa05/attachment.html>