Risk.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Risk where

import Control.Monad.Random
import Control.Monad
import Data.List

------------------------------------------------------------
-- Die values

newtype DieValue = DV { unDV :: Int }
  deriving (Eq, Ord, Show, Num)

first :: (a -> b) -> (a, c) -> (b, c)
first f (a, c) = (f a, c)

instance Random DieValue where
  random           = first DV . randomR (1,6)
  randomR (low,hi) = first DV . randomR (max 1 (unDV low), min 6 (unDV hi))

die :: Rand StdGen DieValue
die = getRandom

------------------------------------------------------------
-- Risk

type Army = Int

data Battlefield = Battlefield { attackers :: Army, defenders :: Army }
  deriving (Show)

applySkirmish :: Battlefield -> (DieValue, DieValue) -> Battlefield
applySkirmish bf@(Battlefield a d) (attackVal, defendVal)
  | a <= 1 || d <= 0      = bf
  | attackVal > defendVal = Battlefield a (d-1)
  | otherwise             = Battlefield (a-1) d

battle :: Battlefield -> Rand StdGen Battlefield
battle bf = do
  attackRolls <- replicateM (numAttackers bf) die
  defendRolls <- replicateM (numDefenders bf) die
  let pairedRolls = zip (sort attackRolls) (sort defendRolls)
  return $ foldl applySkirmish bf pairedRolls
  where numAttackers = bound 0 3 . attackers
        numDefenders = bound 1 2 . defenders

-- $bound
-- >>> bound 3 4 1
-- 3
-- >>> bound 0 4 3
-- 3
-- >>> bound 0 4 5
-- 4
bound :: Int -> Int -> Int -> Int
bound minValue maxValue value = min (max minValue value) maxValue

-- $ex3
-- >>> invade $ Battlefield 4 1
-- 'hi'
invade :: Battlefield -> Rand StdGen Battlefield
invade bf@(Battlefield a d)
  | a <= 1 || d <= 0 = return bf
  | otherwise        = (=<<) invade . battle $ bf
  --                 = battle bf >>= invade

successProb :: Battlefield -> Rand StdGen Double
successProb bf = do
  battles <- replicateM numSamples $ invade bf
  let x = partition attackSucceeded battles
  return (fromIntegral (length $ fst x) / fromIntegral numSamples)
  where numSamples = 100000
        attackSucceeded (Battlefield a d) = a > d

main :: IO ()
main = do
  values <- evalRandIO $ invade (Battlefield 4 4)
  prob <- evalRandIO $ successProb (Battlefield 4 4)
  print values
  print prob