[plt-scheme] please help with generating random permutation

Hi Sigrid,

even true random numbers do not have an uniform distribution if the run is
small enough - to verify you just need to flip a fairly fair coin and count
the number of times where head or tail shows up consecutively.

If you suspect the issue is with the shuffling you should try to increase
the test runs to see if you get a better distribution.

If the criteria of the rotation is "fairness" - i.e. everyone gets their
fair shares of duty, I suspect you will have better luck by simulating card
drawings - where each card drawn stays out of the deck, and reshuffles only
when the deck is empty.

You can persist the state between the drawings if you are not trying to draw
all of the cards at once.

The drawing can itself be randomized - i.e. not always drawing from the top
of the deck.

Checking for "not available" can be implemented as a redraw, or as a
weighted drawing algorithm where you exclude the card from that particular
draw.  You can do the same to avoid consecutive weekday draws for any
individual card.

Lastly - PLT uses pseudo random number generators.  You can try the
vyzo/crypto package, which has a cryptographic random number generator.

Above are what I can think of on top of my head.  HTH.
yc

On Thu, Sep 10, 2009 at 10:49 AM, keydana at gmx.de <keydana at gmx.de> wrote:

> Hi,
>
> I am in a rather uncomfortable situation after writing a script to select
> people for the (not too popular) rotating job of "duty person" in our
> department...
> One colleague complains he is always chosen on Monday. Up till now the
> sample is very small, which would make "proving" this hypothesis impossible,
> but it's not a nice situation all the same, so I would like to make "as sure
> as possible" that the distribution is random.
>
> The part of the script in question works on a weekly basis, generating a
> different "duty person" for every day of a week. It gets any known
> "unavailability events" for the week from our calendar and filters the input
> list accordingly. Then, for every day, it divides the list of people who are
> available into two parts, those who did duty the week before (list A) and
> those who did not (list B). It then uses the amb operator to select a person
> for every day (separately), preferredly from list B but if necessary also
> from list A. In the end, it checks that the 5 people selected are unique,
> else it will backtrack.
>
> Now because it was clear that amb would backtrack in a foreseeable way,
> when the script starts it first shuffles the input list. For the shuffle, I
> am using the function P. Ragde posted here (see
> http://groups.google.com/group/plt-scheme/browse_thread/thread/2b0de444dc77e11f,
> at the end), which was said to have a good random distribution (I also can
> confirm this when I run it e.g. 1000 times in a row).
> However, in my script I run the shuffle only once per execution, and when I
> e.g. run the whole script 20 times and look who is first in the shuffled
> list, I get the following distribution (the numbers stand for the position
> of the collegue in the input list):
>
> 0 xxxxx
> 1 x
> 2 xxx
> 3 xx
> 4 xx
> 5 xx
> 6 x
> 7
> 8 x
>
> Unfortunately this looks like a correlation, and the aforementioned
> colleague is the one above :-;
>
> However, I do not understand this, as the mentioned shuffle function uses
> random, and as I read in the documentation random is seeded with
> current-milliseconds... So it really should get a different seed at every
> execution.
>
> I think that somewhere I must be making a mistake here... I would be very
> grateful for any hints.
> I attach a bit of the code, hopefully  as a clarification of how the
> selection works, although it is not runnable without the rest and the data
> provider of course.
>
> Thanks a lot
> Sigrid
>
>
> (define *morning-duty-people* (shuffle '(AG MB SK MM AK RA AV CM HM)))
>
> (define make-morning-duty-list
>  (lambda (start-date-string type)
>     (with-output-to-file (string-append logs-dir (duty-type-logfile type))
> #:exists 'append
>       (lambda ()
>         (printf "~nGoing to choose duty of type ~a for week starting from
> ~a~n" (duty-type-name type) start-date-string)
>         (let ((from (string-to-date start-date-string)))
>           (if (not (= (date-week-day from) 1))
>               (error "Start date has to be a Monday.")
>               (let ((to (get-date-for-interval from 4))
>                     (previous-from (get-date-for-interval from -7)))
>                 (let ((previous-to (get-date-for-interval previous-from
> 4)))
>                   (let ((known-events-list (get-events from to))
>                         (previous-week-list (get-events previous-from
> previous-to)))
>                     (let ((already-selected (extract-morning-duties
> known-events-list from to))
>                           (unavailables (extract-unavailables
> known-events-list from to))
>                           (previous-week-victims (flatten
> (extract-morning-duties previous-week-list previous-from previous-to))))
>                       (if (all-true? (map (lambda (days-list) (not (null?
> days-list))) already-selected))
>                           (let ((week-of-year (get-week-of-year from)))
>                             (printf "Already chosen for morning duty: ~a~n"
>  (map car already-selected))
>                             (send-email *SERVER* *MAIL-TO* *SENDER* (if
> dry-run (format "DRY RUN: ~a ~a" (duty-type-mail-subject type) week-of-year)
> (format "~a ~a" (duty-type-mail-subject type) week-of-year))
> (insert-variables (duty-type-mail-body-exists type) week-of-year
> (date-to-string from 'short) (date-to-string to 'short) (map car
> already-selected))))
>                           (let ((availables (map (lambda (lst) (complement
> *morning-duty-people* lst)) unavailables))
>                                 (previous-week-spared (complement
> *morning-duty-people* previous-week-victims)))
>                             (when debug (printf "Going to determine morning
> duties for period from ~a to ~a:~nUnavailable are: ~s~nAlready entered are:
> ~s~nChoosable are: ~s~nPrevious week's victims were: ~s~n" (date->string
> from "~Y-~m-~d") (date->string to "~Y-~m-~d") unavailables already-selected
> availables previous-week-victims))
>                             (let ((possible-duties (choose-possible-duties
> availables already-selected previous-week-spared)))
>                               (when debug (printf "Choose-possible-duties
> output: ~s~n" possible-duties))
>                               (check-unique possible-duties)
>                               (when debug (printf "Unique duties are: ~s~n"
> possible-duties))
>                               (if dry-run
>                                   (printf "Not sending events to calendar
> 'cause dry-run~n")
>                                   (let ((result (build-morning-duty-events
> possible-duties from)))
>                                     (let ((new-only (filter (lambda (event)
> (not (event-exists? known-events-list event))) result)))
>                                       (store-events new-only))))
>                               (let ((week-of-year (get-week-of-year from)))
>                                 (send-email *SERVER* *MAIL-TO* *SENDER* (if
> dry-run (format "DRY RUN: ~a ~a" (duty-type-mail-subject type) week-of-year)
> (format "~a ~a" (duty-type-mail-subject type) week-of-year))
> (insert-variables (duty-type-mail-body type) week-of-year (date-to-string
> from 'short) (date-to-string to 'short) possible-duties))))))))))))))))
>
>
> (define choose-possible-duties
>  (lambda (availables-list already-selected-list preferred-list)
>    (when debug (printf "Choose-possible-duties called with
> input:~nAvailable are: ~s~nAlready registered are: ~s~n" availables-list
> already-selected-list))
>    (let loop ((availables availables-list) (selected already-selected-list)
> (result '()))
>      (if (null? availables)
>          (reverse result)
>          (let ((current-date-availables (car availables))
> (current-date-selected (car selected)))
>            (if (not (null? current-date-selected))
>                (let ((already-entered (car current-date-selected)))
>                  (loop (cdr availables) (cdr selected) (cons
> already-entered result)))
>                (let-values (((preferred&available availablebutrathernot)
> (partition (lambda (person) (member person preferred-list))
> current-date-availables)))
>                  (let ((amb-result (grouped-list-amb preferred&available
> availablebutrathernot)))
>                    (loop (cdr availables) (cdr selected) (cons amb-result
> result))))))))))
>
>
>
>
> _________________________________________________
>  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/20090910/011fb5fa/attachment.html>