Risiko (italian risk) probability calculator

risiko.hs

module Risiko where

import System.Random
import Data.List (sortBy)

data Player = Me | Oth

data Situation = Situation { myArmies :: Int
                           , othArmies :: Int }
                 deriving (Show)

type DiceChoice = (Int, Int)
type DiceRoll = ([Int], [Int])

randomGens :: RandomGen r => r -> [r]
randomGens = iterate (fst . split)

roll :: RandomGen r
     => r
     -> DiceChoice
     -> DiceRoll
roll g (dn1, dn2) = (d1, d2)
  where
    randomD :: [Int]
    randomD = randomRs (1,6) g
    d1 :: [Int]
    d1 = sortBy (flip compare)
           $ take dn1 randomD
    d2 :: [Int]
    d2 = sortBy (flip compare)
           $ take dn2 $ drop dn1 randomD

attack :: RandomGen r
       => r
       -> DiceChoice
       -> Situation
       -> Situation
attack g dn (Situation myA othA) = situation'
  where
    results = uncurry (zipWith (>)) $ roll g dn
    situation' = Situation
                   (myA - length (filter not results))
                   (othA - length (filter id results))

attackWithAllDice :: RandomGen r
                  => r
                  -> Situation
                  -> Situation
attackWithAllDice g s@(Situation an1 an2) = attack g diceChoice s
  where
    diceChoice = (min 3 (an1-1), min 3 an2)

conquerOrDie :: RandomGen r
             => r
             -> Situation
             -> Situation
conquerOrDie r = attackUntil r oneDead

oneDead x = victory x || defeat x


victory (Situation a1 a2) = a2 == 0
defeat (Situation a1 a2) = a1 == 1

attackUntil :: RandomGen r
            => r
            -> (Situation -> Bool)
            -> Situation
            -> Situation
attackUntil g cond s = head
                     $ dropWhile (not . cond)
                     $ fst
                     <$> iterate attackAndNext (s,g)
  where
    attackAndNext (s,g) = (attackWithAllDice g1 s,g2)
      where
        (g1,g2) = split g

sim :: RandomGen r
    => r
    -> (Situation -> Bool)
    -> Situation
    -> [Situation]
sim g cond s = (\g' -> attackUntil g' cond s)
               <$> randomGens g

myArmiesLeft ss = fromIntegral (sum $ fmap myArmies ss) / fromIntegral (length ss)
othArmiesLeft ss = fromIntegral (sum $ fmap othArmies ss) / fromIntegral (length ss)
victoryRatio ss = fromIntegral (length $ filter victory ss) / fromIntegral (length ss)