Subject: Re: [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 <[email protected]> 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@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



Programming list archiving by: Enterprise Git Hosting