Programming Praxis – World Cup Prognostication

In today’s Programming Praxis exercise, the goal is to write a simulator for the knockout stage of the World Cup. Let’s get started, shall we?

We’re going to be using a language pragma that I’ll get back to later. Also, some imports.

{-# LANGUAGE BangPatterns #-}

import Control.Monad
import qualified Data.List.Key as K
import qualified Data.Map as M
import System.Random

First, we define the teams and their elo ratings.

teams :: [(String, Float)]
teams = [ ("URU", 1890), ("KOR", 1746), ("USA", 1785), ("GHA", 1711)
        , ("NED", 2045), ("SVK", 1654), ("BRA", 2082), ("CHI", 1883)
        , ("ARG", 1966), ("MEX", 1873), ("GER", 1930), ("ENG", 1945)
        , ("PAR", 1771), ("JPN", 1744), ("ESP", 2061), ("POR", 1874)]

The formulas for determining which team is more likely to win and calculating the new elo rating after a match:

winChance :: Float -> Float -> Float
winChance eloA eloB = 1 / (1 + 10 ** ((eloB - eloA) / 400))

update :: Float -> Float -> Float
update winner loser = winner + 60 * (1 - winChance winner loser)

Match determines the winner of a match given a random number.

match :: Float -> (a, Float) -> (a, Float) -> (a, Float)
match r (a, ea) (b, eb) | r < winChance ea eb = (a, update ea eb)
                        | otherwise           = (b, update eb ea)

A round consists of playing a match for each pair of teams.

simround :: [(a, Float)] -> [Float] -> [(a, Float)]
simround (a:b:xs) (r:rs) = match r a b : simround xs rs
simround _        _      = []

And a tournament is nothing more than a series of successive rounds until there is only one team left.

tournament :: [(a, Float)] -> IO a
tournament [(w,_)] = return w
tournament xs      = tournament . simround xs . randoms =<< newStdGen

And when simulating, we run the desired number of tournaments, keeping a count of the winners. Note the bang pattern in the first argument of foldM, which prevents the stack from exploding. This way, the map gets updated after each tournament instead of ending up with a thunk of a million nested updates.

simulate :: Int -> IO ()
simulate n = print . K.sort (negate . snd) . M.assocs =<<
    foldM (\ !m _ -> fmap (\x -> M.adjust succ x m) $ tournament teams)
          (M.map (const 0) $ M.fromList teams) [1..n]

As usual, a test to if everything works:

main :: IO ()
main = simulate 1000000

Here is a sample simulation, which shows Brazil edging out Spain for first place, just like in the Scheme solution.

[("BRA",224546),("ESP",220703),("NED",191913),("ARG",80102),
 ("ENG",60613),("URU",53444),("GER",49686),("POR",27086),
 ("MEX",24714),("CHI",23611),("USA",14887),("PAR",9225),
 ("KOR",7558),("JPN",6081),("GHA",5009),("SVK",822)]
About these ads

Tags: , , , , , , , ,

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s


Follow

Get every new post delivered to your Inbox.

Join 35 other followers

%d bloggers like this: