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)]