73f4fa86a3
the fisher-yates shuffling algorithm. Thanks to Daniel Prager for the push to fix this and doing most of the work. The timing tests below seem to indicate that it takes a constant amount of time per element (about 1/7th of a microsecond per element on my laptop) and even for 10 element lists it runs faster than the sort-based version that this code replaces. Below is some code that I used to explore the shuffles. I used Mike Bostock diagrams (http://bost.ocks.org/mike/shuffle/compare.html) to double check that the FY algorithm was implemented properly. #lang racket/gui (require pict) ;; some shuffling algorithms: (define (st-shuffle l) (sort l < #:key (λ(_) (random)) #:cache-keys? #t)) (define (fy-shuffle l) (define a (make-vector (length l))) (for ([x (in-list l)] [i (in-naturals)]) (define j (random (add1 i))) (unless (= j i) (vector-set! a i (vector-ref a j))) (vector-set! a j x)) (vector->list a)) (define (naive-swap-random->random l) (define v (apply vector l)) (define len (vector-length v)) (for ([x (in-range len)]) (define n (random len)) (define m (random len)) (define t (vector-ref v n)) (vector-set! v n (vector-ref v m)) (vector-set! v m t)) (vector->list v)) ;; replication of the ``Will it Shuffle?'' diagram (define green '(0 100 0)) (define red '(165 42 42)) (define (shuffle-pict shuffle size) (define pict-size 300) (define sq-size (/ pict-size size)) (define v (build-vector size (λ (i) (make-vector size 0)))) (define ht (make-hash)) (define l (build-list size values)) (define shuffles 10000) (for ([x (in-range shuffles)]) (for ([x (in-list (shuffle l))] [i (in-naturals)]) (define r (vector-ref v x)) (vector-set! r i (+ (vector-ref r i) 1)))) (apply hc-append (for/list ([r (in-vector v)]) (apply vc-append (for/list ([e (in-vector r)]) (colorize (filled-rectangle sq-size sq-size #:draw-border? #f) (triple->color (sq-color shuffles size e)))))))) (define (sq-color shuffles size n) (define mid-point (/ shuffles size)) (cond [(<= n mid-point) (interp-color red (- 1 (map-between (/ mid-point 3) mid-point n)))] [else (interp-color green (map-between mid-point (* mid-point 3) n))])) (define (map-between lower-bound upper-bound n) (cond [(<= lower-bound n upper-bound) (/ (- n lower-bound) (- upper-bound lower-bound))] [(<= n lower-bound) 0] [else 1])) (define (interp-color color %) (define (i n) (- 255 (* (- 255 n) %))) (list (i (list-ref color 0)) (i (list-ref color 1)) (i (list-ref color 2)))) (define (triple->color triple) (define (get n) (inexact->exact (floor (list-ref triple n)))) (make-object color% (get 0) (get 1) (get 2))) (module+ test (require rackunit) (check-equal? (map-between 10 110 0) 0) (check-equal? (map-between 10 110 10) 0) (check-equal? (map-between 10 110 20) 1/10) (check-equal? (map-between 10 110 100) 9/10) (check-equal? (map-between 10 110 150) 1) (check-equal? (sq-color 1000 10 0) red) (check-equal? (sq-color 1000 10 100) (list 255 255 255)) (check-equal? (sq-color 1000 10 1000) green)) (define (pictures) (values (shuffle-pict st-shuffle 60) (shuffle-pict fy-shuffle 60) (shuffle-pict naive-swap-random->random 60))) ;; timing tests (define (time-it a-shuffler size iters) (printf "~a ~a ~a " (object-name a-shuffler) size iters) (flush-output) (define l (build-list size values)) (collect-garbage) (collect-garbage) (collect-garbage) (time (for ([x (in-range iters)]) (a-shuffler l)))) (define (timings) (time-it fy-shuffle 10 100000) (time-it fy-shuffle 100 10000) (time-it fy-shuffle 1000 1000) (time-it fy-shuffle 10000 100) (time-it st-shuffle 10 100000) (time-it st-shuffle 100 10000) (time-it st-shuffle 1000 1000) (time-it st-shuffle 10000 100)) (module+ main (timings)) |
||
|---|---|---|
| .. | ||
| collects | ||
| src | ||
| .gitignore | ||