CIS 194: Homework 12: http://www.seas.upenn.edu/~cis194/lectures.html

Risk.hs

-- http://www.seas.upenn.edu/~cis194/hw/12-monads.pdf
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Risk where

import Control.Monad
import Control.Monad.Random
import Control.Applicative
import Data.List
import Data.Monoid

------------------------------------------------------------
-- 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 (Eq, Show)

dice :: Int -> Rand StdGen [DieValue]
dice n = sequence . replicate n $ die

rolls :: Int -> Rand StdGen [Int]
rolls n = ap (return $ map unDV) (dice n)

outcome :: (Int, Int) -> Battlefield
outcome (a, d)
	| a > d = Battlefield 0 (-1)
	| otherwise = Battlefield (-1) 0

apply f b1 b2 = Battlefield (f (attackers b1) (attackers b2)) (f (defenders b1) (defenders b2))
add = apply (+)

outcomes :: [(Int, Int)] -> Battlefield
outcomes = foldr (add . outcome) (Battlefield 0 0)

compareDesc :: Ord a => a -> a -> Ordering
compareDesc x y = case compare x y of
	LT -> GT
	EQ -> EQ
	GT -> LT

sortDesc :: Ord a => [a] -> [a]
sortDesc = sortBy compareDesc

getAttackerCount (Battlefield a d) = min 3 (a - 1)
getDefenderCount (Battlefield a d) = min 2 d

getBattleCount b = b { attackers = getAttackerCount b, defenders = getDefenderCount b }

pairRolls as ds = zip (sortDesc as) (sortDesc ds)

battleCore b as ds = add b . outcomes $ pairRolls as ds

battle :: Battlefield -> Rand StdGen Battlefield
battle b =
	rolls (attackers c) >>= \as ->
	rolls (defenders c) >>= \ds ->
	return $ battleCore b as ds
		where c = getBattleCount b

invade :: Battlefield -> Rand StdGen Battlefield
invade b@(Battlefield a d)
	| d == 0 || a < 2 = return b
	| otherwise = battle b >>= invade

destroyedCount :: Battlefield -> Int
destroyedCount b
	| defenders b == 0 = 1
	| otherwise = 0

invadeRepeat :: Int -> Battlefield -> Rand StdGen [Battlefield]
invadeRepeat n b = replicateM n (invade b)

invadeDestroyedCount :: Int -> Battlefield -> Rand StdGen Int
invadeDestroyedCount n b = ap (return $ sum . map destroyedCount) (invadeRepeat n b)

getFraction :: Int -> Int -> Double
getFraction denominator numerator = fromIntegral numerator / fromIntegral denominator

successProbN :: Int -> Battlefield -> Rand StdGen Double
successProbN n b = ap (return $ getFraction n) (invadeDestroyedCount n b)

successProb :: Battlefield -> Rand StdGen Double
successProb = successProbN 1000