Predictable random for testing

In my Haskell RPG game, the results of actions are random: I use the standard random generator to simulate the throw of a dice in a table top RPG.
However for writing unit tests that is not ideal, since I would like to be able to test the outcome of an action for a given result of the dice. I didn't
want to clutter the code (even if using a State monad) with something used only for testing, so I experimented with IORef and a custom Test Generator.

First of all, we need a data type to store our non random random generator. It will store a list of results and the index it's at in that list. It's
basically a circular list, so that when we reach the end we start again. If the list is one element long, then the same result will be given for all
dice throws:

data TestGen = TestGen [Int] Int

mkTestGen is just a helper function to initialise the index to 0

mkTestGen l=TestGen l 0

This is the real magic: I thought you needed to pass around an IORef as any other variable to be able to read its results, but in fact this is not necessary,
if somewhat of a kludge:

testGen :: IORef (TestGen)
{-# NOINLINE testGen #-}
testGen=unsafePerformIO (newIORef (mkTestGen []))

This means that testGen is initialized only once as a TestGen with an empty list, no matter how many time it's called. It seemed to work in ghci even
without the NOINLINE pragma. Don't ask me why. So, given a simple setter function:

setTestGen l=do
 writeIORef testGen (mkTestGen l)

We can specify what we want as the random generator. If we have an empty list, we use the standard random generator, otherwise we return the current element
in the list, and increment the index, going back to zero if we overrun the list:

randomInt ::(Int,Int) -> IO (Int) 
randomInt (l,h)=do
 (TestGen list ix)<-readIORef testGen 
 if null list
  then getStdRandom (randomR (l,h))
  else do
   let e=list!!ix
   let ix'=ix+1
   let ix''=if ix'==(length list)
    then 0
    else ix'
   writeIORef testGen (TestGen list ix'')
   if e<l || e>h
    then error (printf "%d not in range (%d,%d)" e l h)
    else return e

And this works, amazingly:

 setTestGen [2]
 l<-replicateM 3 (randomInt (1,6))
 assertEqual ("l is not 3 2s") [2,2,2] l
 setTestGen [2,3,4]
 l<-replicateM 4 (randomInt (1,6))
 assertEqual ("l is not 2,3,4,2") [2,3,4,2] l
 setTestGen []

(Notice how I reset the test generator to standard at the end by passing an empty list).

So now I can test my code with predictable results, that will be still random in production use.
Oops, already found a bug on the first test written with that technique!

Haskell for counting votes!

There's apparently an important election going on in the States. There are also a few interesting articles, for example in the french maths magazine Tangente (no up to date online edition that I could find unfortunately) and in the New Scientist, on how the way you tally votes affect the outcome. Tangente has a stiking example, and I'll go through the 5 vote couting methods they outline with an Haskell implementation of each.
No pesky elephant vs donkey, here, the election is about your favorite female movie star:

data Star = MarylinMonroe | AngelinaJolie | BrigitteBardot | EmmanuelleBeart | ClaudiaCardinale
 deriving (Show,Read,Eq,Bounded,Enum,Ord,Ix)

Note the "deriving Ix" (from Data.Array.IArray) so we can use the stars as array indices.

We have six elector profiles: each profile has ranked the stars in order of preferences, and we have the numbers (in millions, say) of electors for that profile. For example, 7.2 million people prefer MarylinMonroe, then Emanuelle Beart, then Claudia Cardinale, 4.8 millions prefer Angelina Jolie, etc. Here's the full data:

votes :: [(Double,[Star])]
votes = [
 (7.2,[MarylinMonroe,EmmanuelleBeart,ClaudiaCardinale,BrigitteBardot,AngelinaJolie]),
 (4.8,[AngelinaJolie,ClaudiaCardinale,EmmanuelleBeart,BrigitteBardot,MarylinMonroe]),
 (4,[BrigitteBardot,AngelinaJolie,ClaudiaCardinale,EmmanuelleBeart,MarylinMonroe]),
 (3.6,[EmmanuelleBeart,BrigitteBardot,ClaudiaCardinale,AngelinaJolie,MarylinMonroe]),
 (1.6,[ClaudiaCardinale,AngelinaJolie,EmmanuelleBeart,BrigitteBardot,MarylinMonroe]),
 (0.8,[ClaudiaCardinale,BrigitteBardot,EmmanuelleBeart,AngelinaJolie,MarylinMonroe])
 ]

With this we need a few helper method before we're ready to implement our voting algorithms.

We need a way to tally votes for stars, taking into account that several profiles may vote for the same star at the same round (Claudia Cardinale at the first round, say). We use an array with the addition as accumulation function, sorted my popularity

accumVotes ::  [(Star,Double)] ->  [(Star,Double)]
accumVotes v=let
 arr=(accumArray (+) 0 (MarylinMonroe,ClaudiaCardinale) v):: Array Star Double
 in sortBy (\a b -> compare (snd b) (snd a)) (assocs arr)

For some reason I needed to tell GHC about the array type, it couldn't infer it.
We need a way to get the votes for a given round (even if we'll only be using the first round this way)

roundResults :: Int -> [(Star,Double)]
roundResults r=let
 v=map (\(a,b)->(b !! r,a)) votes
 in accumVotes v

And a simple extraction function to get the winner's name from accumulated votes:

bestVote ::[(Star,Double)] -> Star
bestVote v= fst $ head $ (accumVotes v)

Now we're ready. The first algorith is a simple one round voting election:

oneRound :: Star
oneRound=bestVote (roundResults 0)

This makes Marylin Monroe the clear winner. But a lot of countries use a two round system: the most popular candidates after the first round make it through to the second round:

We first need a helper function that retrieves the first element from a first list found in a second list (is there a standard method somewhere?)

findFirst :: Eq a => [a] -> [a] -> a 
findFirst toFind (a:rest) =  if elem a toFind
 then a
 else findFirst toFind rest

Then it's straightforward: we get the first two candidates after the first round, and accumulate their results over all the profiles

twoRounds :: Star
twoRounds= let
 (fr1:fr2:_)=(roundResults 0)
 allScores=map (\(a,b)->(findFirst [fst fr1,fst fr2] b,a)) votes
 in bestVote allScores

Angelina Jolie for President! A third method we can use is to proceed by elimination: at each round, we drop the least popular candidate, until we get only one:

elimination :: Star
elimination=  fst $ elimination' (roundResults 0)
 where
  elimination' ::  [(Star,Double)] -> (Star,Double)
  elimination' (a:b:[])=a
  elimination' l= let
   firstRound= map fst $ init l
   in elimination' $ filter (\a->(snd a) >0.0 ) $ accumVotes $ map (\(a,b)->(findFirst firstRound b,a)) votes

This little recursivity yields Brigitte Bardot. Borda suggested another method: we assign a weight to each candidate depending on its ranking, that weight is used as a multiplier of the votes. First choice gets a total tally of the votes times 5, second choice 4, etc.

borda :: Star
borda = bestVote $ concat $ map (\(a,ss)-> map (\(s,mul)->(s,mul*a)) (zip ss [5,4 .. 1])) votes

And this time, Emanuelle Béart comes on top! Last method we will survey is from Condorcet: we look at each match bewteen two stars in isolation. A match is won if more votes put the first star in front of the second star. We first calculate all the possible matches than consider each won match as 1 vote, and accumulate as before:

condorcet :: Star
condorcet= let
 matches=[[x,y] | x <-allStars, y <- tail [x .. ClaudiaCardinale]]
 matchResults= map (\match->(bestVote $ map (\(a,b)->(findFirst match b,a)) votes,1)) matches
 in bestVote matchResults

And, behold, the winner through this method is... Claudia Cardinale! Five methods, five winners!
Of course these are really quick draft of voting methods, they should take into accound draws, etc... Do not use this code to elect the president of a real country!