From 48568079834695f53325c368f892720708c77c62 Mon Sep 17 00:00:00 2001
From: Zhansong Li <lizhansong@hvariant.com>
Date: Fri, 11 Oct 2019 23:06:33 +1100
Subject: [PATCH 1/6] exercise 1

---
 cis194/week12/zhansongl/Risk.hs     | 52 +++++++++++++++++++++++++++++
 cis194/week12/zhansongl/TestRisk.hs | 19 +++++++++++
 2 files changed, 71 insertions(+)
 create mode 100644 cis194/week12/zhansongl/Risk.hs
 create mode 100644 cis194/week12/zhansongl/TestRisk.hs

diff --git a/cis194/week12/zhansongl/Risk.hs b/cis194/week12/zhansongl/Risk.hs
new file mode 100644
index 00000000..51e8456b
--- /dev/null
+++ b/cis194/week12/zhansongl/Risk.hs
@@ -0,0 +1,52 @@
+{-# OPTIONS_GHC -Wall #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Risk where
+
+import Data.List (sortBy)
+--import Debug.Trace (trace)
+
+import Control.Monad (replicateM)
+import System.Random (StdGen)
+import Control.Monad.Random (MonadRandom(..), Random(..), Rand)
+
+------------------------------------------------------------
+-- 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, Eq)
+
+battleOutcome :: Battlefield -> [DieValue] -> [DieValue] -> Battlefield
+battleOutcome field attackRolls defendRolls = Battlefield attackOutcome defendOutcome
+  where attackOutcome = attackers field - (length . filter not $ result)
+        defendOutcome = defenders field - (length . filter id $ result)
+        result = zipWith (>) attackRollsSorted defendRollsSorted
+        attackRollsSorted = sortBy (flip compare) attackRolls
+        defendRollsSorted = sortBy (flip compare) defendRolls
+
+battle :: Battlefield -> Rand StdGen Battlefield
+battle field
+  | (attackers field <= 1 || defenders field <= 0) = pure field
+  | otherwise = replicateM attackArmy die >>= \attackRolls ->
+                replicateM defendArmy die >>= \defendRolls ->
+                pure $ battleOutcome field attackRolls defendRolls
+      where attackArmy = min 3 (attackers field - 1)
+            defendArmy = min 2 (defenders field)
diff --git a/cis194/week12/zhansongl/TestRisk.hs b/cis194/week12/zhansongl/TestRisk.hs
new file mode 100644
index 00000000..85f59286
--- /dev/null
+++ b/cis194/week12/zhansongl/TestRisk.hs
@@ -0,0 +1,19 @@
+import Risk
+
+import Control.Monad.Trans.Random.Lazy (evalRand)
+import System.Random (mkStdGen, RandomGen(..))
+
+import Test.Hspec
+
+main = hspec $ do
+  describe "battle" $ do
+    it "should do nothing when there isn't enough attackers" $ do
+      (battle (Battlefield 0 12) `evalRand` mkStdGen 42) `shouldBe` (Battlefield 0 12)
+      (battle (Battlefield 1 12) `evalRand` mkStdGen 42) `shouldBe` (Battlefield 1 12)
+    it "should do nothing when there isn't enough defenders" $ do
+      (battle (Battlefield 12 0) `evalRand` mkStdGen 42) `shouldBe` (Battlefield 12 0)
+
+    describe "battleOutcome" $ do
+      it "should produce the correct outcome given enough attackers and defenders" $ do
+        (battleOutcome (Battlefield 3 5) (fmap DV [3,5]) (fmap DV [4,3])) `shouldBe` (Battlefield 2 4)
+        (battleOutcome (Battlefield 12 12) (fmap DV [1,4,2]) (fmap DV [3,5])) `shouldBe` (Battlefield 10 12)

From e5538f974c326a72f225875f99e44db996b4e89e Mon Sep 17 00:00:00 2001
From: Zhansong Li <lizhansong@hvariant.com>
Date: Fri, 11 Oct 2019 23:57:44 +1100
Subject: [PATCH 2/6] exercise 2

---
 cis194/week12/zhansongl/Risk.hs     | 10 ++++++++--
 cis194/week12/zhansongl/TestRisk.hs |  7 ++++++-
 2 files changed, 14 insertions(+), 3 deletions(-)

diff --git a/cis194/week12/zhansongl/Risk.hs b/cis194/week12/zhansongl/Risk.hs
index 51e8456b..78485c98 100644
--- a/cis194/week12/zhansongl/Risk.hs
+++ b/cis194/week12/zhansongl/Risk.hs
@@ -3,11 +3,13 @@
 
 module Risk where
 
+import Control.Monad (replicateM)
+import Control.Monad.Loops (iterateUntilM)
 import Data.List (sortBy)
 --import Debug.Trace (trace)
-
-import Control.Monad (replicateM)
 import System.Random (StdGen)
+
+-- monadrandom
 import Control.Monad.Random (MonadRandom(..), Random(..), Rand)
 
 ------------------------------------------------------------
@@ -50,3 +52,7 @@ battle field
                 pure $ battleOutcome field attackRolls defendRolls
       where attackArmy = min 3 (attackers field - 1)
             defendArmy = min 2 (defenders field)
+
+invade :: Battlefield -> Rand StdGen Battlefield
+invade = iterateUntilM battleOver battle
+  where battleOver (Battlefield a d) = a <= 1 || d <= 0
diff --git a/cis194/week12/zhansongl/TestRisk.hs b/cis194/week12/zhansongl/TestRisk.hs
index 85f59286..210d4eae 100644
--- a/cis194/week12/zhansongl/TestRisk.hs
+++ b/cis194/week12/zhansongl/TestRisk.hs
@@ -1,7 +1,7 @@
 import Risk
 
 import Control.Monad.Trans.Random.Lazy (evalRand)
-import System.Random (mkStdGen, RandomGen(..))
+import System.Random (mkStdGen)
 
 import Test.Hspec
 
@@ -17,3 +17,8 @@ main = hspec $ do
       it "should produce the correct outcome given enough attackers and defenders" $ do
         (battleOutcome (Battlefield 3 5) (fmap DV [3,5]) (fmap DV [4,3])) `shouldBe` (Battlefield 2 4)
         (battleOutcome (Battlefield 12 12) (fmap DV [1,4,2]) (fmap DV [3,5])) `shouldBe` (Battlefield 10 12)
+
+  describe "invade" $ do
+    it "should battle until either army is depleted" $ do
+      invade (Battlefield 100 101) `evalRand` mkStdGen 42
+      `shouldSatisfy` \(Battlefield a d) -> a <= 1 || d <= 0

From 33d14ab8743e4723f2118b80ec06f420e91d7a16 Mon Sep 17 00:00:00 2001
From: Zhansong Li <lizhansong@hvariant.com>
Date: Sat, 12 Oct 2019 00:04:28 +1100
Subject: [PATCH 3/6] two attackers, not one

---
 cis194/week12/zhansongl/Risk.hs     | 2 +-
 cis194/week12/zhansongl/TestRisk.hs | 4 ++--
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/cis194/week12/zhansongl/Risk.hs b/cis194/week12/zhansongl/Risk.hs
index 78485c98..f5dbf56e 100644
--- a/cis194/week12/zhansongl/Risk.hs
+++ b/cis194/week12/zhansongl/Risk.hs
@@ -55,4 +55,4 @@ battle field
 
 invade :: Battlefield -> Rand StdGen Battlefield
 invade = iterateUntilM battleOver battle
-  where battleOver (Battlefield a d) = a <= 1 || d <= 0
+  where battleOver (Battlefield a d) = a <= 2 || d <= 0
diff --git a/cis194/week12/zhansongl/TestRisk.hs b/cis194/week12/zhansongl/TestRisk.hs
index 210d4eae..aea724fe 100644
--- a/cis194/week12/zhansongl/TestRisk.hs
+++ b/cis194/week12/zhansongl/TestRisk.hs
@@ -20,5 +20,5 @@ main = hspec $ do
 
   describe "invade" $ do
     it "should battle until either army is depleted" $ do
-      invade (Battlefield 100 101) `evalRand` mkStdGen 42
-      `shouldSatisfy` \(Battlefield a d) -> a <= 1 || d <= 0
+      (invade (Battlefield 100 10) `evalRand` mkStdGen 42) `shouldSatisfy` \(Battlefield a d) -> d <= 0
+      (invade (Battlefield 300 10000) `evalRand` mkStdGen 42) `shouldSatisfy` \(Battlefield a d) -> a <= 2

From 180e3f006d68c5be3e5e9e5ca8a7941f091009bb Mon Sep 17 00:00:00 2001
From: Zhansong Li <lizhansong@hvariant.com>
Date: Sat, 12 Oct 2019 00:23:18 +1100
Subject: [PATCH 4/6] exercise 4

---
 cis194/week12/zhansongl/Risk.hs | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/cis194/week12/zhansongl/Risk.hs b/cis194/week12/zhansongl/Risk.hs
index f5dbf56e..8b139d63 100644
--- a/cis194/week12/zhansongl/Risk.hs
+++ b/cis194/week12/zhansongl/Risk.hs
@@ -4,13 +4,14 @@
 module Risk where
 
 import Control.Monad (replicateM)
-import Control.Monad.Loops (iterateUntilM)
 import Data.List (sortBy)
 --import Debug.Trace (trace)
 import System.Random (StdGen)
 
 -- monadrandom
 import Control.Monad.Random (MonadRandom(..), Random(..), Rand)
+-- monad-loops
+import Control.Monad.Loops (iterateUntilM)
 
 ------------------------------------------------------------
 -- Die values
@@ -56,3 +57,9 @@ battle field
 invade :: Battlefield -> Rand StdGen Battlefield
 invade = iterateUntilM battleOver battle
   where battleOver (Battlefield a d) = a <= 2 || d <= 0
+
+successProb :: Battlefield -> Rand StdGen Double
+successProb b = (/) <$> (fromIntegral <$> successCount) <*> pure 1000
+  where rs = replicateM 1000 . invade $ b
+        successCount = (length . filter winning) <$> rs
+        winning (Battlefield a _) = a > 2

From 6aae3dcfb9639c952d47d9e9d7c41d125b9affa2 Mon Sep 17 00:00:00 2001
From: Zhansong Li <lizhansong@hvariant.com>
Date: Sat, 12 Oct 2019 02:21:25 +1100
Subject: [PATCH 5/6] exercise 5

---
 cis194/week12/zhansongl/Risk.hs | 37 ++++++++++++++++++++++++++++++---
 1 file changed, 34 insertions(+), 3 deletions(-)

diff --git a/cis194/week12/zhansongl/Risk.hs b/cis194/week12/zhansongl/Risk.hs
index 8b139d63..5789756f 100644
--- a/cis194/week12/zhansongl/Risk.hs
+++ b/cis194/week12/zhansongl/Risk.hs
@@ -4,7 +4,7 @@
 module Risk where
 
 import Control.Monad (replicateM)
-import Data.List (sortBy)
+import Data.List (sortBy, sort, group)
 --import Debug.Trace (trace)
 import System.Random (StdGen)
 
@@ -59,7 +59,38 @@ invade = iterateUntilM battleOver battle
   where battleOver (Battlefield a d) = a <= 2 || d <= 0
 
 successProb :: Battlefield -> Rand StdGen Double
-successProb b = (/) <$> (fromIntegral <$> successCount) <*> pure 1000
-  where rs = replicateM 1000 . invade $ b
+successProb b = (/) <$> (fromIntegral <$> successCount) <*> pure 10000
+  where rs = replicateM 10000 . invade $ b
         successCount = (length . filter winning) <$> rs
         winning (Battlefield a _) = a > 2
+
+cartProd :: [m a] -> [m a] -> [(m a, m a)]
+cartProd o1 o2 = [(x,y) | x <- o1, y <- o2]
+
+outcome :: Int -> [[Int]]
+outcome 0 = []
+outcome 1 = [[1], [2], [3], [4], [5], [6]]
+outcome n = fmap (sortBy $ flip compare) . fmap (uncurry (++)) $ cartProd (outcome 1) (outcome $ n-1)
+
+fightOutcome :: ([Int], [Int]) -> (Int, Int)
+fightOutcome (as, ds) = (aloss, dloss)
+  where r = zipWith (>) as ds
+        dloss = length . filter id $ r
+        aloss = length . filter not $ r
+
+outcomeProb :: Int -> Int -> [(Int, Int, Double)]
+outcomeProb a d = zipWith p (fmap head . group $ r) (fmap length . group $ r)
+  where r = sort . fmap fightOutcome $ cartProd (outcome a) (outcome d)
+        denom = length r
+        p (aloss, dloss) num = (aloss, dloss, fromIntegral num / fromIntegral denom)
+
+exactSuccessProb :: Battlefield -> Double
+exactSuccessProb (Battlefield a d)
+  | a <= 2 = 0
+  | d <= 0 = 1
+  | otherwise = sum
+              . fmap (\(aloss, dloss, prob)
+                      -> (exactSuccessProb $ Battlefield (a - aloss) (d - dloss)) * prob)
+              $ outcomeProb as ds
+  where as = min 3 (a-1)
+        ds = min 2 d

From d894d5fcb418776d9bc75fbdc34cada46c30e1a5 Mon Sep 17 00:00:00 2001
From: Zhansong Li <lizhansong@hvariant.com>
Date: Sat, 12 Oct 2019 23:03:14 +1100
Subject: [PATCH 6/6] fix logic: fewer than two attackers, not <= 2

---
 cis194/week12/zhansongl/Risk.hs     | 6 +++---
 cis194/week12/zhansongl/TestRisk.hs | 2 +-
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/cis194/week12/zhansongl/Risk.hs b/cis194/week12/zhansongl/Risk.hs
index 5789756f..95f1f894 100644
--- a/cis194/week12/zhansongl/Risk.hs
+++ b/cis194/week12/zhansongl/Risk.hs
@@ -56,13 +56,13 @@ battle field
 
 invade :: Battlefield -> Rand StdGen Battlefield
 invade = iterateUntilM battleOver battle
-  where battleOver (Battlefield a d) = a <= 2 || d <= 0
+  where battleOver (Battlefield a d) = a <= 1 || d <= 0
 
 successProb :: Battlefield -> Rand StdGen Double
 successProb b = (/) <$> (fromIntegral <$> successCount) <*> pure 10000
   where rs = replicateM 10000 . invade $ b
         successCount = (length . filter winning) <$> rs
-        winning (Battlefield a _) = a > 2
+        winning (Battlefield a _) = a > 1
 
 cartProd :: [m a] -> [m a] -> [(m a, m a)]
 cartProd o1 o2 = [(x,y) | x <- o1, y <- o2]
@@ -86,7 +86,7 @@ outcomeProb a d = zipWith p (fmap head . group $ r) (fmap length . group $ r)
 
 exactSuccessProb :: Battlefield -> Double
 exactSuccessProb (Battlefield a d)
-  | a <= 2 = 0
+  | a <= 1 = 0
   | d <= 0 = 1
   | otherwise = sum
               . fmap (\(aloss, dloss, prob)
diff --git a/cis194/week12/zhansongl/TestRisk.hs b/cis194/week12/zhansongl/TestRisk.hs
index aea724fe..bf0f73ab 100644
--- a/cis194/week12/zhansongl/TestRisk.hs
+++ b/cis194/week12/zhansongl/TestRisk.hs
@@ -21,4 +21,4 @@ main = hspec $ do
   describe "invade" $ do
     it "should battle until either army is depleted" $ do
       (invade (Battlefield 100 10) `evalRand` mkStdGen 42) `shouldSatisfy` \(Battlefield a d) -> d <= 0
-      (invade (Battlefield 300 10000) `evalRand` mkStdGen 42) `shouldSatisfy` \(Battlefield a d) -> a <= 2
+      (invade (Battlefield 300 10000) `evalRand` mkStdGen 42) `shouldSatisfy` \(Battlefield a d) -> a <= 1