drawing names, take 2

It turns out, the consummate dunce who originally posted the Perl code mentioned in my previous post (and whose code I used as a model to write mine) was thoughtful enough to include the possibility of infinite recursion in some cases.

Suppose you have drawn n - 2 names, and Ann and Bill still need gift-recipients; Curtis The Dunce and Bill are the names in the hat. So, Ann reaches in and gets Curtis. (Of course, he is a bad little boy who won’t get any presents. But that’s another story.) Then Bill chooses… well, duh. Problem. This is the bug in Perl-boy’s code.

As a public service, I have updated my code to eliminate this possibility. Enjoy your bug-free gift-name-drawing.

(* Draw randomly-selected names for each person in `nameList'. *)structure DrawNames = structlocaltype match = {name: string, match: string}

(* Set of strings. *)structure S = BinarySetFn(type ord_key = string                          val compare = String.compare)

(* List of all names. *)val nameList = ["Denis", "Lisa", "Dave", "Beth", "Tim", "Emma"]val names = S.addList (S.empty, nameList)

(* For the random-number generator seed. This seed is only sufficient. *)fun getpid () =    SysWord.toInt (Posix.Process.pidToWord (Posix.ProcEnv.getpid ()))fun now () =    let val time = Time.toMilliseconds (Time.now ())        val time' = case Int.maxInt                     of NONE => time                      | SOME x => LargeInt.mod (time, Int.toLarge x)    in Int.fromLarge time'    end

in

(* Match up all the names. *)fun match () =    let val seed = Random.rand (now (), getpid ())        fun randomElt l =            List.nth (l, (Random.randRange (0, (length l) - 1) seed))        fun getName set =            randomElt (S.listItems set)        fun getNameExcluding (excl, set) =            randomElt (S.listItems (S.difference (set, S.singleton excl)))

        (* Find a match for the given `name'. *)        fun findMatch (mapFrom, mapTo, matches) =            if S.isEmpty mapFrom            then matches            else let val name = getName mapFrom                     val match = getNameExcluding (name, mapTo)                     val mapFrom' = S.delete (mapFrom, name)                     val mapTo' = S.delete (mapTo, match)                 (* If the only choice is to map to oneself, we made the                  * wrong choice: try again. *)                 in if S.numItems mapFrom' = 1                       andalso S.equal (mapFrom', mapTo')                    then findMatch (mapFrom, mapTo, matches)                    else findMatch (mapFrom', mapTo',                                    {from=name, to=match} :: matches)                 end        fun printMatch {from, to} = print (from ^ " -> " ^ to ^ "\n")

        val matches = findMatch (names, names, [])    in app printMatch matches    end

end (* local *)end (* struct *)

this site brought to you by the letter p and the number e.