From: Neil Smith <neil.git@njae.me.uk>
Date: Sat, 25 Dec 2021 22:16:37 +0000 (+0000)
Subject: Done day 21 part 2
X-Git-Url: https://git.njae.me.uk/?a=commitdiff_plain;h=8307ab6717ea4ceaff6691cbc3fc5acf70335f79;p=advent-of-code-21.git

Done day 21 part 2
---

diff --git a/advent-of-code21.cabal b/advent-of-code21.cabal
index 121c742..b760b36 100644
--- a/advent-of-code21.cabal
+++ b/advent-of-code21.cabal
@@ -210,4 +210,4 @@ executable advent20
 executable advent21
   import: common-extensions, build-directives
   main-is: advent21/Main.hs
-  build-depends: text, attoparsec, mtl, containers, monad-loops
+  build-depends: text, attoparsec, containers, multiset
diff --git a/advent21/Main.hs b/advent21/Main.hs
index 5a76130..f187b98 100644
--- a/advent21/Main.hs
+++ b/advent21/Main.hs
@@ -1,8 +1,11 @@
 -- Writeup at https://work.njae.me.uk/2021/12/23/advent-of-code-2021-day-20/
 
+import Debug.Trace
+
+
 import Data.Text ()
 import qualified Data.Text.IO as TIO
-import Data.Attoparsec.Text hiding (take, takeWhile, dropWhile)
+import Data.Attoparsec.Text hiding (take, takeWhile)
 import Control.Applicative
 
 -- import Control.Monad.State.Strict
@@ -13,19 +16,34 @@ import Control.Applicative
 
 import qualified Data.Map.Strict as M
 import Data.Map.Strict ((!))
+import Data.List
+import qualified Data.MultiSet as MS
 
 data Player = Player1 | Player2 deriving (Eq, Ord, Show)
 
 data PlayerState = PlayerState 
   { position :: Int
   , score :: Int
-  } deriving (Eq, Show)
+  } deriving (Eq, Ord, Show)
 
 data Game = Game 
   { players :: M.Map Player PlayerState
   , current :: Player
   , rolls :: Int
-  } deriving (Eq, Show)
+  } deriving (Eq, Ord)
+
+type Games = MS.MultiSet Game
+type Dice = MS.MultiSet Int
+type Winners = MS.MultiSet Player
+
+
+instance Show Game where
+
+  show game = "{" ++ (showPlayer Player1) ++ (showActive) ++ (showPlayer Player2) ++ "}"
+    where showPlayer p = (show $ position $ (players game) ! p) ++ "," ++ (show $ score $ (players game) ! p) 
+          showActive = if (current game) == Player1 then "<" else ">"
+
+
 
 
 -- type GameState = State Game
@@ -35,32 +53,34 @@ main :: IO ()
 main = 
   do  text <- TIO.readFile "data/advent21.txt"
       let game = successfulParse text
-      print game
-      print $ gameStep game
-      print $ take 8 $ iterate gameStep game
-      print $ finished game
       print $ part1 game
-      -- let (enhancement, image) = parse text
-      -- print $ part1 enhancement image
-      -- print $ part2 enhancement image
+      print $ part2 game
 
 part1 game = scoreGame finalGame
-  where finalGame = head $ dropWhile (not . finished) $ iterate gameStep game
+  where finalGame = head $ dropWhile (not . finished 1000) $ scanl' gameStep game detDice
+        detDice = map (\n -> sum ([d `mod1` 100 | d <- [n..(n+2)]]::[Int])) [1, 4..]
+
+part2 game = max (Player1 `MS.occur` winners) (Player2 `MS.occur` winners)
+  where games0 = MS.singleton game
+        winners0 = MS.empty
+        winners = nonDetGameSimulation 21 games0 diracDice winners0
 
-finished game = any (>= 1000) $ map score $ M.elems (players game)
+finished :: Int -> Game -> Bool
+finished threshold game = any (>= threshold) $ map score $ M.elems (players game)
 
+scoreGame :: Game -> Int
 scoreGame game = (rolls game) * losingScore
   where losingScore = minimum $ map score $ M.elems (players game)
 
+diracDice :: Dice
+diracDice = MS.fromList [a + b + c | a <- [1..3], b <- [1..3], c <- [1..3]]
 
-gameStep :: Game -> Game
-gameStep game = game'
-  where rs = rolls game + 1
-        theseRolls = [n `mod1` 100 | n <- [rs..(rs + 2)]] :: [Int]
-        activePlayer = (players game) ! (current game)
+gameStep :: Game -> Int -> Game
+gameStep game theseRolls = game'
+  where activePlayer = (players game) ! (current game)
         pos = position activePlayer
         sc = score activePlayer
-        pos' = (pos + (sum theseRolls)) `mod1` 10
+        pos' = (pos + theseRolls) `mod1` 10
         sc' = sc + pos'
         activePlayer' = PlayerState {position = pos', score = sc'}
         current' = nextPlayer (current game)
@@ -70,8 +90,36 @@ gameStep game = game'
                      , rolls = rolls game + 3
                      }
 
-
-
+nonDetGameSimulation :: Int -> Games -> Dice -> Winners -> Winners
+nonDetGameSimulation winThreshold games0 dice winners0 
+  -- | trace ((show games0) ++ "; " ++ (show winners0)) False = undefined
+  -- | trace (show winners0) False = undefined
+  | MS.null games0 = winners0
+  | otherwise = nonDetGameSimulation winThreshold games dice winners
+  where games' = nonDetGameStep games0 dice
+        (winGames, games) = MS.partition (finished winThreshold) games'
+        p1Wins = MS.size $ MS.filter (\g -> current g == Player2) winGames
+        p2Wins = MS.size $ MS.filter (\g -> current g == Player1) winGames
+        winners = MS.insertMany Player2 p2Wins $ MS.insertMany Player1 p1Wins winners0
+
+nonDetGameStep :: Games -> Dice -> Games
+nonDetGameStep games dice = MS.foldOccur (nonDetGameStep1 dice) MS.empty games
+-- nonDetGameStep games dice 
+  -- | trace ("G0 >" ++ (show games) ++ "-" ++ (show dice)) False = undefined
+  -- | otherwise = MS.foldOccur (nonDetGameStep1 games) MS.empty dice
+
+nonDetGameStep1 :: Dice -> Game -> MS.Occur -> Games -> Games
+nonDetGameStep1 dice game gnum acc = MS.foldOccur (nonDetGameStep2 game gnum) MS.empty dice
+-- nonDetGameStep1 game dice dnum acc 
+  -- | trace ("G1 >" ++ (show game) ++ "-" ++ (show dice) ++ ": " ++ (show gnum)) False = undefined
+  -- | otherwise = MS.foldOccur (nonDetGameStep2 dice dnum) acc game
+
+nonDetGameStep2 :: Game -> MS.Occur -> Int -> MS.Occur -> Games -> Games
+nonDetGameStep2 game gnum roll dnum acc = MS.insertMany game' (gnum * dnum) acc
+-- nonDetGameStep2 dice dnum game gnum acc
+  -- | trace ("G2 >" ++ (show game) ++ "-" ++ (show dice) ++ ": " ++ (show gnum) ++ "," ++ (show dnum)) False = undefined
+  -- | otherwise = MS.insertMany game' (gnum * dnum) acc
+  where game' = gameStep game roll
 
 
 nextPlayer :: Player -> Player
@@ -81,6 +129,8 @@ nextPlayer Player2 = Player1
 mod1 :: Int -> Int -> Int
 mod1 a b = ((a - 1) `mod` b) + 1
 
+
+
 -- Parsing
 
 playerP = ("1" *> pure Player1) <|> ("2" *> pure Player2)