From 57f9cdf69754ff80f55015561c6d123216b32a32 Mon Sep 17 00:00:00 2001
From: Steve Mao <maochenyan@gmail.com>
Date: Thu, 10 Oct 2019 22:58:50 +1100
Subject: [PATCH 01/16] init

---
 cis194/week12/stevemao/Risk.hs | 28 ++++++++++++++++++++++++++++
 1 file changed, 28 insertions(+)
 create mode 100644 cis194/week12/stevemao/Risk.hs

diff --git a/cis194/week12/stevemao/Risk.hs b/cis194/week12/stevemao/Risk.hs
new file mode 100644
index 00000000..f7fde70f
--- /dev/null
+++ b/cis194/week12/stevemao/Risk.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Risk where
+
+import Control.Monad.Random
+
+------------------------------------------------------------
+-- 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 }

From a28e163ad45e6c6dbdb5286d07f610958956e43f Mon Sep 17 00:00:00 2001
From: Steve Mao <maochenyan@gmail.com>
Date: Thu, 10 Oct 2019 23:14:05 +1100
Subject: [PATCH 02/16] Exercise 2

---
 cis194/week12/stevemao/Risk.hs | 44 ++++++++++++++++++++++++++++++++++
 1 file changed, 44 insertions(+)

diff --git a/cis194/week12/stevemao/Risk.hs b/cis194/week12/stevemao/Risk.hs
index f7fde70f..9d9405db 100644
--- a/cis194/week12/stevemao/Risk.hs
+++ b/cis194/week12/stevemao/Risk.hs
@@ -3,6 +3,7 @@
 module Risk where
 
 import Control.Monad.Random
+import Data.List
 
 ------------------------------------------------------------
 -- Die values
@@ -26,3 +27,46 @@ die = getRandom
 type Army = Int
 
 data Battlefield = Battlefield { attackers :: Army, defenders :: Army }
+
+threeDies :: Rand StdGen [DieValue]
+threeDies =
+  die >>= \d1 ->
+  die >>= \d2 ->
+  die >>= \d3 ->
+  return . reverse . sort $ [d1,d2,d3]
+
+twoDies :: Rand StdGen [DieValue]
+twoDies =
+  die >>= \d1 ->
+  die >>= \d2 ->
+  return . reverse . sort $ [d1,d2]
+  
+oneDie :: Rand StdGen [DieValue]
+oneDie = 
+  die >>= \d ->
+  return [d]
+
+dieMany :: Int -> Rand StdGen [DieValue]
+dieMany 1 = oneDie
+dieMany 2 = twoDies
+dieMany _ = threeDies
+
+compareTwoLists :: [DieValue] -> [DieValue] -> [Bool]
+compareTwoLists (a : as) (d : ds) = (a > d) : compareTwoLists as ds
+compareTwoLists [] _ = []
+compareTwoLists _ [] = []
+
+count   :: Eq a => a -> [a] -> Int
+count x =  length . filter (==x)
+
+battle :: Battlefield -> Rand StdGen Battlefield
+battle (Battlefield a d) = do 
+  let maxA = min (a - 1) 3
+  let maxD = min d 2
+
+  attacks <- dieMany maxA
+  defends <- dieMany maxD
+
+  let results = compareTwoLists attacks defends
+
+  return . Battlefield (a - count True results) $ d - count False results

From 8ab0a7064de7889dab0856ea2afa9d3e8a6b7ac3 Mon Sep 17 00:00:00 2001
From: Steve Mao <maochenyan@gmail.com>
Date: Fri, 11 Oct 2019 08:45:43 +1100
Subject: [PATCH 03/16] Exercise 3

---
 cis194/week12/stevemao/Risk.hs | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/cis194/week12/stevemao/Risk.hs b/cis194/week12/stevemao/Risk.hs
index 9d9405db..19a63b5a 100644
--- a/cis194/week12/stevemao/Risk.hs
+++ b/cis194/week12/stevemao/Risk.hs
@@ -70,3 +70,9 @@ battle (Battlefield a d) = do
   let results = compareTwoLists attacks defends
 
   return . Battlefield (a - count True results) $ d - count False results
+
+invade :: Battlefield -> Rand StdGen Battlefield
+invade b@(Battlefield _ 0) = pure b
+invade b@(Battlefield a _)
+  | a < 2 = pure b
+  | otherwise = battle b >>= invade

From 0f531427b7006aaed2e7e1dc87a69d9e0bd12d95 Mon Sep 17 00:00:00 2001
From: Steve Mao <maochenyan@gmail.com>
Date: Fri, 11 Oct 2019 09:43:16 +1100
Subject: [PATCH 04/16] Exercise 4

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

diff --git a/cis194/week12/stevemao/Risk.hs b/cis194/week12/stevemao/Risk.hs
index 19a63b5a..55d72c99 100644
--- a/cis194/week12/stevemao/Risk.hs
+++ b/cis194/week12/stevemao/Risk.hs
@@ -76,3 +76,12 @@ invade b@(Battlefield _ 0) = pure b
 invade b@(Battlefield a _)
   | a < 2 = pure b
   | otherwise = battle b >>= invade
+
+calculateResult :: Double -> Double -> Rand StdGen Double
+calculateResult 1000 attackersWins = pure (attackersWins / 1000)
+calculateResult n attackersWins = invade (Battlefield 6 6) >>= f
+  where f (Battlefield _ 0) = calculateResult (n + 1) (attackersWins + 1)
+        f _ = calculateResult (n + 1) attackersWins
+
+successProb :: Battlefield -> Rand StdGen Double
+successProb b = calculateResult 0 0

From 24e473daf5233946749c068e9b153cf7e7cc8e6c Mon Sep 17 00:00:00 2001
From: Steve Mao <maochenyan@gmail.com>
Date: Fri, 11 Oct 2019 22:46:39 +1100
Subject: [PATCH 05/16] fix

---
 cis194/week12/stevemao/Risk.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/cis194/week12/stevemao/Risk.hs b/cis194/week12/stevemao/Risk.hs
index 55d72c99..25f00adf 100644
--- a/cis194/week12/stevemao/Risk.hs
+++ b/cis194/week12/stevemao/Risk.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -Wall #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 module Risk where
@@ -77,11 +78,10 @@ invade b@(Battlefield a _)
   | a < 2 = pure b
   | otherwise = battle b >>= invade
 
-calculateResult :: Double -> Double -> Rand StdGen Double
-calculateResult 1000 attackersWins = pure (attackersWins / 1000)
-calculateResult n attackersWins = invade (Battlefield 6 6) >>= f
-  where f (Battlefield _ 0) = calculateResult (n + 1) (attackersWins + 1)
-        f _ = calculateResult (n + 1) attackersWins
-
 successProb :: Battlefield -> Rand StdGen Double
 successProb b = calculateResult 0 0
+  where calculateResult :: Double -> Double -> Rand StdGen Double
+        calculateResult 1000 attackersWins = pure (attackersWins / 1000)
+        calculateResult n attackersWins = invade b >>= f
+          where f (Battlefield _ 0) = calculateResult (n + 1) (attackersWins + 1)
+                f _ = calculateResult (n + 1) attackersWins
\ No newline at end of file

From c9ed6b5ca40b327fad0f148d38ba4084e8d93775 Mon Sep 17 00:00:00 2001
From: Steve Mao <maochenyan@gmail.com>
Date: Sat, 12 Oct 2019 00:24:20 +1100
Subject: [PATCH 06/16] Battlefield deriving Show

---
 cis194/week12/stevemao/Risk.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/cis194/week12/stevemao/Risk.hs b/cis194/week12/stevemao/Risk.hs
index 25f00adf..e1cfb501 100644
--- a/cis194/week12/stevemao/Risk.hs
+++ b/cis194/week12/stevemao/Risk.hs
@@ -28,6 +28,7 @@ die = getRandom
 type Army = Int
 
 data Battlefield = Battlefield { attackers :: Army, defenders :: Army }
+  deriving Show
 
 threeDies :: Rand StdGen [DieValue]
 threeDies =
@@ -84,4 +85,4 @@ successProb b = calculateResult 0 0
         calculateResult 1000 attackersWins = pure (attackersWins / 1000)
         calculateResult n attackersWins = invade b >>= f
           where f (Battlefield _ 0) = calculateResult (n + 1) (attackersWins + 1)
-                f _ = calculateResult (n + 1) attackersWins
\ No newline at end of file
+                f _ = calculateResult (n + 1) attackersWins

From 2fb32455eebe668363589813b96a738cd96f3022 Mon Sep 17 00:00:00 2001
From: Steve Mao <maochenyan@gmail.com>
Date: Sat, 12 Oct 2019 20:10:56 +1100
Subject: [PATCH 07/16] simplify dieMany

---
 cis194/week12/stevemao/Risk.hs | 23 ++---------------------
 1 file changed, 2 insertions(+), 21 deletions(-)

diff --git a/cis194/week12/stevemao/Risk.hs b/cis194/week12/stevemao/Risk.hs
index e1cfb501..e37f12cb 100644
--- a/cis194/week12/stevemao/Risk.hs
+++ b/cis194/week12/stevemao/Risk.hs
@@ -30,28 +30,8 @@ type Army = Int
 data Battlefield = Battlefield { attackers :: Army, defenders :: Army }
   deriving Show
 
-threeDies :: Rand StdGen [DieValue]
-threeDies =
-  die >>= \d1 ->
-  die >>= \d2 ->
-  die >>= \d3 ->
-  return . reverse . sort $ [d1,d2,d3]
-
-twoDies :: Rand StdGen [DieValue]
-twoDies =
-  die >>= \d1 ->
-  die >>= \d2 ->
-  return . reverse . sort $ [d1,d2]
-  
-oneDie :: Rand StdGen [DieValue]
-oneDie = 
-  die >>= \d ->
-  return [d]
-
 dieMany :: Int -> Rand StdGen [DieValue]
-dieMany 1 = oneDie
-dieMany 2 = twoDies
-dieMany _ = threeDies
+dieMany n = fmap (reverse . sort) . replicateM n $ die
 
 compareTwoLists :: [DieValue] -> [DieValue] -> [Bool]
 compareTwoLists (a : as) (d : ds) = (a > d) : compareTwoLists as ds
@@ -79,6 +59,7 @@ invade b@(Battlefield a _)
   | a < 2 = pure b
   | otherwise = battle b >>= invade
 
+-- TODO: make the simulator run in parallel
 successProb :: Battlefield -> Rand StdGen Double
 successProb b = calculateResult 0 0
   where calculateResult :: Double -> Double -> Rand StdGen Double

From c9b43192e6ba2077dbeabd2ccc200253a1e1a8ab Mon Sep 17 00:00:00 2001
From: Steve Mao <maochenyan@gmail.com>
Date: Sat, 12 Oct 2019 20:19:51 +1100
Subject: [PATCH 08/16] fix

---
 cis194/week12/stevemao/Risk.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/cis194/week12/stevemao/Risk.hs b/cis194/week12/stevemao/Risk.hs
index e37f12cb..d5f78708 100644
--- a/cis194/week12/stevemao/Risk.hs
+++ b/cis194/week12/stevemao/Risk.hs
@@ -51,7 +51,7 @@ battle (Battlefield a d) = do
 
   let results = compareTwoLists attacks defends
 
-  return . Battlefield (a - count True results) $ d - count False results
+  return . Battlefield (a - count False results) $ d - count True results
 
 invade :: Battlefield -> Rand StdGen Battlefield
 invade b@(Battlefield _ 0) = pure b

From cea02ef5f054eb10eb1950bfdd7a24477d947c07 Mon Sep 17 00:00:00 2001
From: Steve Mao <maochenyan@gmail.com>
Date: Sat, 12 Oct 2019 20:50:29 +1100
Subject: [PATCH 09/16] make the simulator run in parallel

---
 cis194/week12/stevemao/Risk.hs | 11 ++++-------
 1 file changed, 4 insertions(+), 7 deletions(-)

diff --git a/cis194/week12/stevemao/Risk.hs b/cis194/week12/stevemao/Risk.hs
index d5f78708..5e97f3de 100644
--- a/cis194/week12/stevemao/Risk.hs
+++ b/cis194/week12/stevemao/Risk.hs
@@ -59,11 +59,8 @@ invade b@(Battlefield a _)
   | a < 2 = pure b
   | otherwise = battle b >>= invade
 
--- TODO: make the simulator run in parallel
 successProb :: Battlefield -> Rand StdGen Double
-successProb b = calculateResult 0 0
-  where calculateResult :: Double -> Double -> Rand StdGen Double
-        calculateResult 1000 attackersWins = pure (attackersWins / 1000)
-        calculateResult n attackersWins = invade b >>= f
-          where f (Battlefield _ 0) = calculateResult (n + 1) (attackersWins + 1)
-                f _ = calculateResult (n + 1) attackersWins
+successProb b = fmap (\bs -> (foldr f 0 bs) / 1000) . replicateM 1000 . invade $ b
+  where f :: Battlefield -> Double -> Double
+        f (Battlefield _ 0) acc = acc + 1
+        f _ acc = acc

From 4ed50d5026a51264f2b63d602ad0b5ef3c631d38 Mon Sep 17 00:00:00 2001
From: Steve Mao <maochenyan@gmail.com>
Date: Sat, 12 Oct 2019 23:08:44 +1100
Subject: [PATCH 10/16] simplify with zipWith

---
 cis194/week12/stevemao/Risk.hs | 10 +++-------
 1 file changed, 3 insertions(+), 7 deletions(-)

diff --git a/cis194/week12/stevemao/Risk.hs b/cis194/week12/stevemao/Risk.hs
index 5e97f3de..69ce1a75 100644
--- a/cis194/week12/stevemao/Risk.hs
+++ b/cis194/week12/stevemao/Risk.hs
@@ -33,11 +33,6 @@ data Battlefield = Battlefield { attackers :: Army, defenders :: Army }
 dieMany :: Int -> Rand StdGen [DieValue]
 dieMany n = fmap (reverse . sort) . replicateM n $ die
 
-compareTwoLists :: [DieValue] -> [DieValue] -> [Bool]
-compareTwoLists (a : as) (d : ds) = (a > d) : compareTwoLists as ds
-compareTwoLists [] _ = []
-compareTwoLists _ [] = []
-
 count   :: Eq a => a -> [a] -> Int
 count x =  length . filter (==x)
 
@@ -49,7 +44,7 @@ battle (Battlefield a d) = do
   attacks <- dieMany maxA
   defends <- dieMany maxD
 
-  let results = compareTwoLists attacks defends
+  let results = zipWith (>) attacks defends
 
   return . Battlefield (a - count False results) $ d - count True results
 
@@ -60,7 +55,8 @@ invade b@(Battlefield a _)
   | otherwise = battle b >>= invade
 
 successProb :: Battlefield -> Rand StdGen Double
-successProb b = fmap (\bs -> (foldr f 0 bs) / 1000) . replicateM 1000 . invade $ b
+successProb b = fmap (\bs -> (foldr f 0 bs) / simCount) . replicateM simCount . invade $ b
   where f :: Battlefield -> Double -> Double
         f (Battlefield _ 0) acc = acc + 1
         f _ acc = acc
+        simCount = 1000

From 215fbfcb0f614bca8e22e215f87abde4ee724a69 Mon Sep 17 00:00:00 2001
From: Steve Mao <maochenyan@gmail.com>
Date: Sun, 13 Oct 2019 09:48:51 +1100
Subject: [PATCH 11/16] fix

---
 cis194/week12/stevemao/Risk.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/cis194/week12/stevemao/Risk.hs b/cis194/week12/stevemao/Risk.hs
index 69ce1a75..661e1a08 100644
--- a/cis194/week12/stevemao/Risk.hs
+++ b/cis194/week12/stevemao/Risk.hs
@@ -55,8 +55,8 @@ invade b@(Battlefield a _)
   | otherwise = battle b >>= invade
 
 successProb :: Battlefield -> Rand StdGen Double
-successProb b = fmap (\bs -> (foldr f 0 bs) / simCount) . replicateM simCount . invade $ b
+successProb b = fmap (\bs -> (foldr f 0 bs) / fromIntegral simCount) . replicateM simCount . invade $ b
   where f :: Battlefield -> Double -> Double
         f (Battlefield _ 0) acc = acc + 1
         f _ acc = acc
-        simCount = 1000
+        simCount = 1000 :: Int

From 4e8dc730b8dd3b5c8c4cc2508af8e73d2567ddf6 Mon Sep 17 00:00:00 2001
From: Steve Mao <maochenyan@gmail.com>
Date: Sun, 13 Oct 2019 09:50:06 +1100
Subject: [PATCH 12/16] start using DI

---
 cis194/week12/stevemao/Risk.hs | 11 +++++++----
 1 file changed, 7 insertions(+), 4 deletions(-)

diff --git a/cis194/week12/stevemao/Risk.hs b/cis194/week12/stevemao/Risk.hs
index 661e1a08..7efd25e0 100644
--- a/cis194/week12/stevemao/Risk.hs
+++ b/cis194/week12/stevemao/Risk.hs
@@ -36,17 +36,20 @@ dieMany n = fmap (reverse . sort) . replicateM n $ die
 count   :: Eq a => a -> [a] -> Int
 count x =  length . filter (==x)
 
-battle :: Battlefield -> Rand StdGen Battlefield
-battle (Battlefield a d) = do 
+battle' :: Monad m => (Int -> m [DieValue]) -> Battlefield -> m Battlefield
+battle' m (Battlefield a d) = do 
   let maxA = min (a - 1) 3
   let maxD = min d 2
 
-  attacks <- dieMany maxA
-  defends <- dieMany maxD
+  attacks <- m maxA
+  defends <- m maxD
 
   let results = zipWith (>) attacks defends
 
   return . Battlefield (a - count False results) $ d - count True results
+  
+battle :: Battlefield -> Rand StdGen Battlefield
+battle = battle' dieMany
 
 invade :: Battlefield -> Rand StdGen Battlefield
 invade b@(Battlefield _ 0) = pure b

From 3775896bc166e91007b8c6e37d4d9486042ee1c6 Mon Sep 17 00:00:00 2001
From: Steve Mao <maochenyan@gmail.com>
Date: Tue, 15 Oct 2019 17:07:48 +1100
Subject: [PATCH 13/16] temp

---
 cis194/week12/stevemao/Risk.hs | 68 ++++++++++++++++++++++++++++++++--
 1 file changed, 65 insertions(+), 3 deletions(-)

diff --git a/cis194/week12/stevemao/Risk.hs b/cis194/week12/stevemao/Risk.hs
index 7efd25e0..0e6f0405 100644
--- a/cis194/week12/stevemao/Risk.hs
+++ b/cis194/week12/stevemao/Risk.hs
@@ -5,12 +5,14 @@ module Risk where
 
 import Control.Monad.Random
 import Data.List
+import Data.Universe.Helpers
+import Data.Tree
 
 ------------------------------------------------------------
 -- Die values
 
 newtype DieValue = DV { unDV :: Int } 
-  deriving (Eq, Ord, Show, Num)
+  deriving (Eq, Ord, Show, Num, Enum)
 
 first :: (a -> b) -> (a, c) -> (b, c)
 first f (a, c) = (f a, c)
@@ -29,9 +31,34 @@ type Army = Int
 
 data Battlefield = Battlefield { attackers :: Army, defenders :: Army }
   deriving Show
-
+  
+-- data SteveTuple a b = SteveTuple (a, b)
+-- 
+-- instance Functor (SteveTuple a) where
+--   -- fmap f (SteveTuple (a, a')) = SteveTuple (f a, f a')
+-- 
+-- instance Applicative (SteveTuple a) where
+--   -- SteveTuple (a, a') <*> SteveTuple (b, b') = SteveTuple (a b, a' b')
+-- 
+-- instance Monad (SteveTuple a) where
+--   SteveTuple (a, a') >>= f = SteveTuple (a >>= f, a' >>= b')
+-- 
+-- bibind
+
+-- bibind :: (a1, m a) -> ((a1, a) -> ([a], m a)) -> m a
+-- bibind = undefined
+-- 
+-- foldBind :: Monad m => m a -> ([a], m a) -> Int -> ([a], m a)
+-- foldBind _ (as, m) 1 = (as, m)
+-- foldBind m' (as, m) n = bibind (as, m) newM
+--   where newM = \(as, r) -> (as ++ [r], m >>= )
+
+sortReverse :: Functor f => f [DieValue] -> f [DieValue]
+sortReverse = fmap (reverse . sort)
+
+-- TODO: replicateM is wrong. Use fold bind
 dieMany :: Int -> Rand StdGen [DieValue]
-dieMany n = fmap (reverse . sort) . replicateM n $ die
+dieMany n = sortReverse . replicateM n $ die
 
 count   :: Eq a => a -> [a] -> Int
 count x =  length . filter (==x)
@@ -63,3 +90,38 @@ successProb b = fmap (\bs -> (foldr f 0 bs) / fromIntegral simCount) . replicate
         f (Battlefield _ 0) acc = acc + 1
         f _ acc = acc
         simCount = 1000 :: Int
+
+cartprod :: [[a]] -> [[a]];
+cartprod [] = [[]]
+cartprod (xs:xss) = [x:ys | x<- xs, ys <-yss]
+                        where yss = cartprod xss
+
+diePlanned :: Int -> [[DieValue]]
+diePlanned n = sortReverse . cartprod . replicate n $ [1..6]
+
+battleAll :: Battlefield -> [Battlefield]
+battleAll (Battlefield a d) = do
+  let maxA = min (a - 1) 3
+  let maxD = min d 2
+
+  let attackss = diePlanned maxA -- [[1,1,1], [2,1,1]...]
+  let defendss = diePlanned maxD -- [[1,1], [2,1]...]
+
+  let allResults = if length (concat attackss) > 0 && length (concat defendss) > 0 then attackss +*+ defendss else [] -- [([1,1,1], [1,1]), ([2,1,1], [1,1])...]
+
+  fmap (\r -> Battlefield (a - count False r) $ d - count True r) $ fmap (\result -> uncurry (zipWith (>)) result) allResults
+
+buildTree :: Battlefield -> Tree Battlefield
+buildTree = unfoldTree f
+  where f :: Battlefield -> (Battlefield, [Battlefield])
+        f b = (b, battleAll b)
+
+calculateProb :: Tree Battlefield -> Double
+calculateProb = foldTree f
+  where f :: Battlefield -> [Double] -> Double
+        f (Battlefield _ 0) [] = 1
+        f _ [] = 0
+        f _ forest = sum forest / fromIntegral (length forest)
+
+exactSuccessProb :: Battlefield -> Double
+exactSuccessProb = calculateProb . buildTree

From 7b56e1df1e271c15513f0ab08bf2c371289c2e6f Mon Sep 17 00:00:00 2001
From: Steve Mao <maochenyan@gmail.com>
Date: Tue, 15 Oct 2019 17:41:20 +1100
Subject: [PATCH 14/16] exactSuccessProb using tree

---
 cis194/week12/stevemao/Risk.hs | 71 +++++++++++++---------------------
 1 file changed, 27 insertions(+), 44 deletions(-)

diff --git a/cis194/week12/stevemao/Risk.hs b/cis194/week12/stevemao/Risk.hs
index 0e6f0405..9b8bcdd3 100644
--- a/cis194/week12/stevemao/Risk.hs
+++ b/cis194/week12/stevemao/Risk.hs
@@ -31,35 +31,22 @@ type Army = Int
 
 data Battlefield = Battlefield { attackers :: Army, defenders :: Army }
   deriving Show
-  
--- data SteveTuple a b = SteveTuple (a, b)
--- 
--- instance Functor (SteveTuple a) where
---   -- fmap f (SteveTuple (a, a')) = SteveTuple (f a, f a')
--- 
--- instance Applicative (SteveTuple a) where
---   -- SteveTuple (a, a') <*> SteveTuple (b, b') = SteveTuple (a b, a' b')
--- 
--- instance Monad (SteveTuple a) where
---   SteveTuple (a, a') >>= f = SteveTuple (a >>= f, a' >>= b')
--- 
--- bibind
-
--- bibind :: (a1, m a) -> ((a1, a) -> ([a], m a)) -> m a
--- bibind = undefined
--- 
--- foldBind :: Monad m => m a -> ([a], m a) -> Int -> ([a], m a)
--- foldBind _ (as, m) 1 = (as, m)
--- foldBind m' (as, m) n = bibind (as, m) newM
---   where newM = \(as, r) -> (as ++ [r], m >>= )
 
 sortReverse :: Functor f => f [DieValue] -> f [DieValue]
-sortReverse = fmap (reverse . sort)
+sortReverse = fmap $ reverse . sort
 
 -- TODO: replicateM is wrong. Use fold bind
 dieMany :: Int -> Rand StdGen [DieValue]
 dieMany n = sortReverse . replicateM n $ die
 
+cartprod :: [[a]] -> [[a]];
+cartprod [] = [[]]
+cartprod (xs:xss) = [x:ys | x<- xs, ys <-yss]
+                        where yss = cartprod xss
+
+diePlanned :: Int -> [[DieValue]]
+diePlanned n = sortReverse . cartprod . replicate n $ [1..6]
+
 count   :: Eq a => a -> [a] -> Int
 count x =  length . filter (==x)
 
@@ -74,10 +61,26 @@ battle' m (Battlefield a d) = do
   let results = zipWith (>) attacks defends
 
   return . Battlefield (a - count False results) $ d - count True results
-  
+
 battle :: Battlefield -> Rand StdGen Battlefield
 battle = battle' dieMany
 
+battleAll :: Battlefield -> [Battlefield]
+battleAll (Battlefield _ 0) = []
+battleAll (Battlefield a d)
+  | a < 2 = []
+  | otherwise = do
+      let maxA = min (a - 1) 3
+      let maxD = min d 2
+
+      let attackss = diePlanned maxA -- [[1,1,1], [2,1,1]...]
+      let defendss = diePlanned maxD -- [[1,1], [2,1]...]
+
+      let allPossibilities = attackss +*+ defendss -- [([1,1,1], [1,1]), ([2,1,1], [1,1])...]
+      let allResults = fmap (uncurry $ zipWith (>)) allPossibilities
+
+      fmap (\r -> Battlefield (a - count False r) $ d - count True r) allResults
+
 invade :: Battlefield -> Rand StdGen Battlefield
 invade b@(Battlefield _ 0) = pure b
 invade b@(Battlefield a _)
@@ -85,32 +88,12 @@ invade b@(Battlefield a _)
   | otherwise = battle b >>= invade
 
 successProb :: Battlefield -> Rand StdGen Double
-successProb b = fmap (\bs -> (foldr f 0 bs) / fromIntegral simCount) . replicateM simCount . invade $ b
+successProb = fmap (\bs -> foldr f 0 bs / fromIntegral simCount) . replicateM simCount . invade
   where f :: Battlefield -> Double -> Double
         f (Battlefield _ 0) acc = acc + 1
         f _ acc = acc
         simCount = 1000 :: Int
 
-cartprod :: [[a]] -> [[a]];
-cartprod [] = [[]]
-cartprod (xs:xss) = [x:ys | x<- xs, ys <-yss]
-                        where yss = cartprod xss
-
-diePlanned :: Int -> [[DieValue]]
-diePlanned n = sortReverse . cartprod . replicate n $ [1..6]
-
-battleAll :: Battlefield -> [Battlefield]
-battleAll (Battlefield a d) = do
-  let maxA = min (a - 1) 3
-  let maxD = min d 2
-
-  let attackss = diePlanned maxA -- [[1,1,1], [2,1,1]...]
-  let defendss = diePlanned maxD -- [[1,1], [2,1]...]
-
-  let allResults = if length (concat attackss) > 0 && length (concat defendss) > 0 then attackss +*+ defendss else [] -- [([1,1,1], [1,1]), ([2,1,1], [1,1])...]
-
-  fmap (\r -> Battlefield (a - count False r) $ d - count True r) $ fmap (\result -> uncurry (zipWith (>)) result) allResults
-
 buildTree :: Battlefield -> Tree Battlefield
 buildTree = unfoldTree f
   where f :: Battlefield -> (Battlefield, [Battlefield])

From cf23afa675f99b32c5ba0c19f2d1fa0c2f7a4c34 Mon Sep 17 00:00:00 2001
From: Steve Mao <maochenyan@gmail.com>
Date: Wed, 16 Oct 2019 22:22:54 +1100
Subject: [PATCH 15/16] improve perf

---
 cis194/week12/stevemao/Risk.hs | 34 +++++++++++++++++++++-------------
 1 file changed, 21 insertions(+), 13 deletions(-)

diff --git a/cis194/week12/stevemao/Risk.hs b/cis194/week12/stevemao/Risk.hs
index 9b8bcdd3..b1148fe9 100644
--- a/cis194/week12/stevemao/Risk.hs
+++ b/cis194/week12/stevemao/Risk.hs
@@ -7,6 +7,8 @@ import Control.Monad.Random
 import Data.List
 import Data.Universe.Helpers
 import Data.Tree
+import Data.Bifunctor
+import Debug.Trace
 
 ------------------------------------------------------------
 -- Die values
@@ -14,8 +16,8 @@ import Data.Tree
 newtype DieValue = DV { unDV :: Int } 
   deriving (Eq, Ord, Show, Num, Enum)
 
-first :: (a -> b) -> (a, c) -> (b, c)
-first f (a, c) = (f a, c)
+-- first :: (a -> b) -> (a, c) -> (b, c)
+-- first f (a, c) = (f a, c)
 
 instance Random DieValue where
   random           = first DV . randomR (1,6)
@@ -35,7 +37,6 @@ data Battlefield = Battlefield { attackers :: Army, defenders :: Army }
 sortReverse :: Functor f => f [DieValue] -> f [DieValue]
 sortReverse = fmap $ reverse . sort
 
--- TODO: replicateM is wrong. Use fold bind
 dieMany :: Int -> Rand StdGen [DieValue]
 dieMany n = sortReverse . replicateM n $ die
 
@@ -50,6 +51,9 @@ diePlanned n = sortReverse . cartprod . replicate n $ [1..6]
 count   :: Eq a => a -> [a] -> Int
 count x =  length . filter (==x)
 
+countSnd :: Eq a => a -> [(b, a)] -> Int
+countSnd x = count x . fmap snd
+
 battle' :: Monad m => (Int -> m [DieValue]) -> Battlefield -> m Battlefield
 battle' m (Battlefield a d) = do 
   let maxA = min (a - 1) 3
@@ -65,7 +69,7 @@ battle' m (Battlefield a d) = do
 battle :: Battlefield -> Rand StdGen Battlefield
 battle = battle' dieMany
 
-battleAll :: Battlefield -> [Battlefield]
+battleAll :: Battlefield -> [(Double, Battlefield)]
 battleAll (Battlefield _ 0) = []
 battleAll (Battlefield a d)
   | a < 2 = []
@@ -79,7 +83,11 @@ battleAll (Battlefield a d)
       let allPossibilities = attackss +*+ defendss -- [([1,1,1], [1,1]), ([2,1,1], [1,1])...]
       let allResults = fmap (uncurry $ zipWith (>)) allPossibilities
 
-      fmap (\r -> Battlefield (a - count False r) $ d - count True r) allResults
+      let allResultsWithPercent = foldr (\curr acc -> if countSnd curr acc == 0 then (1, curr) : acc else fmap (\(co, cu) -> if cu == curr then (co + 1, cu) else (co, cu)) acc) [] allResults
+      let allResultsNum = fromIntegral $ length allResults
+      
+      let ret = fmap (bimap (/ allResultsNum) (\r -> Battlefield (a - count False r) $ d - count True r)) allResultsWithPercent
+      trace ("ret: " ++ show ret) ret
 
 invade :: Battlefield -> Rand StdGen Battlefield
 invade b@(Battlefield _ 0) = pure b
@@ -94,17 +102,17 @@ successProb = fmap (\bs -> foldr f 0 bs / fromIntegral simCount) . replicateM si
         f _ acc = acc
         simCount = 1000 :: Int
 
-buildTree :: Battlefield -> Tree Battlefield
-buildTree = unfoldTree f
-  where f :: Battlefield -> (Battlefield, [Battlefield])
-        f b = (b, battleAll b)
+buildTree :: Battlefield -> Tree (Double, Battlefield)
+buildTree b = unfoldTree f (1, b)
+  where f :: (Double, Battlefield) -> ((Double, Battlefield), [(Double, Battlefield)])
+        f c@(_, ba) = (c, battleAll ba)
 
-calculateProb :: Tree Battlefield -> Double
+calculateProb :: Tree (Double, Battlefield) -> Double
 calculateProb = foldTree f
-  where f :: Battlefield -> [Double] -> Double
-        f (Battlefield _ 0) [] = 1
+  where f :: (Double, Battlefield) -> [Double] -> Double
+        f (percent, Battlefield _ 0) [] = percent
         f _ [] = 0
-        f _ forest = sum forest / fromIntegral (length forest)
+        f (percent, _) forest = sum . fmap (* percent) $ forest 
 
 exactSuccessProb :: Battlefield -> Double
 exactSuccessProb = calculateProb . buildTree

From 66bc332447aa8d168a1d3f7502f396df408a1a13 Mon Sep 17 00:00:00 2001
From: Steve Mao <maochenyan@gmail.com>
Date: Wed, 16 Oct 2019 23:37:46 +1100
Subject: [PATCH 16/16] tweak

---
 cis194/week12/stevemao/Risk.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/cis194/week12/stevemao/Risk.hs b/cis194/week12/stevemao/Risk.hs
index b1148fe9..abbd4fe2 100644
--- a/cis194/week12/stevemao/Risk.hs
+++ b/cis194/week12/stevemao/Risk.hs
@@ -87,7 +87,7 @@ battleAll (Battlefield a d)
       let allResultsNum = fromIntegral $ length allResults
       
       let ret = fmap (bimap (/ allResultsNum) (\r -> Battlefield (a - count False r) $ d - count True r)) allResultsWithPercent
-      trace ("ret: " ++ show ret) ret
+      trace (show ret) ret
 
 invade :: Battlefield -> Rand StdGen Battlefield
 invade b@(Battlefield _ 0) = pure b