hw12/Risk.hs

   1 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
   2
   3 module Risk where
   4
   5 import Control.Applicative
   6 import Control.Monad.Random
   7 import Control.Monad(replicateM, liftM, foldM)
   8 import Data.List(sortBy)
   9
  10 ------------------------------------------------------------
  11 -- Die values
  12
  13 newtype DieValue = DV { unDV :: Int }
  14   deriving (Eq, Ord, Show, Num)
  15
  16 first :: (a -> b) -> (a, c) -> (b, c)
  17 first f (a, c) = (f a, c)
  18
  19 instance Random DieValue where
  20   random           = first DV . randomR (1,6)
  21   randomR (low,hi) = first DV . randomR (max 1 (unDV low), min 6 (unDV hi))
  22
  23 die :: Rand StdGen DieValue
  24 die = getRandom
  25
  26 ------------------------------------------------------------
  27 -- Risk
  28
  29 type Army = Int
  30
  31 data Battlefield = Battlefield { attackers :: Army, defenders :: Army }
  32
  33 newBattlefield :: Battlefield -> [DieValue] -> [DieValue] -> Battlefield
  34 newBattlefield battlefield rollA rollB =
  35     let pairList = zip (sortBy (flip compare) rollA) (sortBy (flip compare) rollB)
  36     in
  37       foldr (\(a, d) acc -> if a > d then Battlefield (attackers acc) ((defenders acc) - 1)
  38                             else Battlefield ((attackers acc) - 1)  (defenders acc)) battlefield pairList
  39
  40
  41 battle :: Battlefield -> Rand StdGen Battlefield
  42 battle (Battlefield {attackers = a, defenders = d}) =
  43   let rolla = replicateM (min (a - 1) 3) die
  44       rolld = replicateM (min d 2) die
  45   in
  46     liftA2 (newBattlefield (Battlefield a d)) rolla rolld
  47
  48 -- exercise 3.
  49 endgame :: Battlefield -> Bool
  50 endgame (Battlefield {attackers=a, defenders=d}) = d == 0 || a < 2
  51
  52 enemyDestroyed :: Battlefield -> Bool
  53 enemyDestroyed bf = endgame bf && (defenders bf) == 1
  54
  55 invade :: Battlefield -> Rand StdGen Battlefield
  56 -- invade battlefield = foldM (\acc f -> f $ acc) battlefield (repeat battle)
  57 invade battlefield = battle battlefield >>= \bf ->
  58                      if (endgame bf) then return bf
  59                      else invade bf
  60 -- exercise 4
  61 successProb :: Battlefield -> Rand StdGen Double
  62 successProb battlefield = (pure (filter enemyDestroyed) <*> replicateM 1000 (invade battlefield))
  63                           >>= \xs -> return (fromIntegral (length xs) / 1000)