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

From: Joe Marshall (jmarshall at alum.mit.edu)
Date: Sun Aug 9 14:41:42 EDT 2009

Alas, my technique doesn't create a uniform distribution.


On Sun, Aug 9, 2009 at 10:56 AM, Phil Bewig<pbewig at gmail.com> wrote:
> 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
>
>
> _________________________________________________
>  For list-related administrative tasks:
>  http://list.cs.brown.edu/mailman/listinfo/plt-scheme
>
>



-- 
~jrm


Posted on the users mailing list.