The Racket repository
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)) |
||
|---|---|---|
| native-pkgs@2f116c1b64 | ||
| pkgs | ||
| racket | ||
| .gitattributes | ||
| .gitignore | ||
| .gitmodules | ||
| .mailmap | ||
| .travis.yml | ||
| INSTALL.txt | ||
| Makefile | ||
| README.txt | ||
This is the source code for the main Racket distribution. See "INSTALL.txt" for information on building Racket. License ------- Racket Copyright (c) 2010-2014 PLT Design Inc. Racket is distributed under the GNU Lesser General Public License (LGPL). This means that you can link Racket into proprietary applications, provided you follow the rules stated in the LGPL. You can also modify Racket; if you distribute a modified version, you must distribute it under the terms of the LGPL, which in particular means that you must release the source code for the modified software. See racket/src/COPYING_LESSER.txt for more information.