[plt-scheme] please help with generating random permutation

From: keydana at gmx.de (keydana at gmx.de)
Date: Thu Sep 10 16:31:19 EDT 2009

Hi YC, hi Will,

thanks a lot for your quick answers! I will try out your suggestions  
tomorrow at work where I have access to the data, but I would already  
like to ask some questions back now as I won't be able to write from  
the mail address I'm using with the PLT list
tomorrow during the day.

YC, I will try out the vyzo/crypto package thanks to your hint. I also  
wondered if I should use random-source-randomize!  from SRFI-27. There  
is also an example in the docs for generating random permutations,  
which I could possibly use. Would you recommend trying this?

Regarding the point about drawing single cards, my concept (and the  
whole idea in the beginning quite some time ago...) was in fact to use  
amb, and I only added the "pre-shuffling" later when I realized that  
if I don't have enough constraints, amb will always choose the same  
person... Perhaps the initial idea about amb was not so good after  
all. Only now I think I won't have the time to rework the whole  
"algorithm" until the colleague gets impatient :-;
Anyway, from your suggestion about serializing the state between runs  
of the script it occurred to me that perhaps I don't need the pre- 
shuffle at all. I could just rotate the list at every run and  
serialize it - then at least it would be "fair".

Will, thanks for explaining the statistics. It's a stupid thing to  
ask, but... to check with an appropriate sample I really have to re- 
execute the script independently each time, correct? Because if I do  
it in a loop like I tried out quickly, the pseudo random number  
generator will use it's internal state, whereas what I need to know is  
the outcome on each first shuffle only? Sorry for asking such a simple  
thing, really...

Thanks again, I will check things out tomorrow,

Am 10.09.2009 um 21:29 schrieb YC:

> 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 (seehttp://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/03044b37/attachment.html>

Posted on the users mailing list.