Day 9, parts 1 & 2: Initial solutions.

Day5/Part2.hs

@@ -1,6 +1,6 @@
 #! /usr/bin/env stack
 -- stack --resolver lts-12.20 --install-ghc script
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE FlexibleContexts, LambdaCase #-}
 module Main where
 
 import Data.Function (fix, on)
@@ -9,15 +9,16 @@ import qualified Data.List as L
 
 main :: IO ()
 main = interact $ \input -> show $ L.minimumBy (compare `on` snd) $
-   [ let rs = react input' in ((rs, r), length rs)
+   [ react $ filter (\c -> C.isAlpha c && c /= r && c /= C.toUpper r) input
    | r <- ['a'..'z']
-   , let input' = [ c | c <- input, C.isAlpha c, c /= r, c /= C.toUpper r ]
    ]
 
-react [] = []
-react (x:(react -> ys))
-   | (y:ys') <- ys, x `reactsWith` y = ys'
-   | otherwise                       = x:ys
+react input =
+   let scan (x:y:zs) = if x `reactsWith` y then scan zs else (x : scan (y:zs))
+       scan zs = zs
+       input' = scan input
+       result = (input', length input')
+   in if input' == input then result else react input'
 
 x `reactsWith` y = (C.isUpper x && C.toLower x == y) ||
                    (C.isLower x && C.toUpper x == y)

Day9/Part1.hs

@@ -0,0 +1,71 @@
+#! /usr/bin/env stack
+-- stack --resolver lts-12.20 --install-ghc script
+{-# LANGUAGE LambdaCase, TemplateHaskell #-}
+module Main where
+
+import Control.Category ((>>>), (<<<))
+import Control.Lens
+import qualified Control.Monad.State as St
+import qualified Data.List           as L
+import qualified Data.Map            as M
+import qualified Data.Sequence       as Seq
+
+import Debug.Trace
+
+type Score  = Int
+type Marble = Int
+
+-- Circular sequence convention:
+-- current <| first CW <| ... <| first CCW
+
+data Game = Game
+   { _gameMarbles :: Seq.Seq Marble
+   , _gamePlayers :: Seq.Seq Score
+   } deriving Show
+makeClassy ''Game
+
+-- 1st CCW becomes current; current becomes 1st CW
+rotateCW :: (HasGame c) => Int -> St.State c ()
+rotateCW n = St.replicateM_ n $ St.modify $ game . gameMarbles %~ \case
+   s' :> x -> x <| s'
+
+-- 1st CW becomes current; current becomes 1st CCW
+rotateCCW :: (HasGame c) => Int -> St.State c ()
+rotateCCW n = St.replicateM_ n $ St.modify $ game . gameMarbles %~ \case
+   x :< s' -> s' |> x
+
+nextPlayer :: (HasGame c) => St.State c ()
+nextPlayer = St.modify $ game . gamePlayers %~ \case
+   x :< s' -> s' |> x
+
+insertMarble :: (HasGame c) => Marble -> St.State c ()
+insertMarble m = St.modify $ game . gameMarbles %~ (m <|)
+
+removeMarble :: (HasGame c) => St.State c Marble
+removeMarble = St.state $ game . gameMarbles %%~ \case
+   x :< s' -> (x, s')
+
+addScore :: (HasGame c) => Int -> St.State c ()
+addScore delta = St.modify $ game . gamePlayers . _head +~ delta
+
+newGame nPlayers = Game
+   { _gameMarbles = Seq.singleton 0
+   , _gamePlayers = Seq.replicate nPlayers 0
+   }
+
+runGame :: Int -> Int -> Game
+runGame nPlayers lastMarble = flip St.execState (newGame nPlayers) $ do
+   St.forM_ [1..lastMarble] $ \marble -> do
+      --St.get >>= traceM . show
+      if marble `mod` 23 /= 0
+      then rotateCCW 2 *> insertMarble marble
+      else do
+         addScore marble
+         rotateCW 7
+         m <- removeMarble
+         addScore m
+      nextPlayer
+
+main :: IO ()
+--main = print $ runGame 9 25
+main = print $ maximum $ view gamePlayers $ runGame 416 71617

Day9/Part2.hs

@@ -0,0 +1,72 @@
+#! /usr/bin/env stack
+-- stack --resolver lts-12.20 --install-ghc script
+{-# LANGUAGE LambdaCase, TemplateHaskell #-}
+module Main where
+
+import Control.Category ((>>>), (<<<))
+import Control.Lens
+import qualified Control.Monad.State as St
+import qualified Data.List           as L
+import qualified Data.Map            as M
+import qualified Data.Sequence       as Seq
+
+import Debug.Trace
+
+type Score  = Int
+type Marble = Int
+
+-- Circular sequence convention:
+-- current <| first CW <| ... <| first CCW
+
+data Game = Game
+   { _gameMarbles :: Seq.Seq Marble
+   , _gamePlayers :: Seq.Seq Score
+   } deriving Show
+makeClassy ''Game
+
+-- 1st CCW becomes current; current becomes 1st CW
+rotateCW :: (HasGame c) => Int -> St.State c ()
+rotateCW n = St.replicateM_ n $ St.modify $ game . gameMarbles %~ \case
+   s' :> x -> x <| s'
+
+-- 1st CW becomes current; current becomes 1st CCW
+rotateCCW :: (HasGame c) => Int -> St.State c ()
+rotateCCW n = St.replicateM_ n $ St.modify $ game . gameMarbles %~ \case
+   x :< s' -> s' |> x
+
+nextPlayer :: (HasGame c) => St.State c ()
+nextPlayer = St.modify $ game . gamePlayers %~ \case
+   x :< s' -> s' |> x
+
+insertMarble :: (HasGame c) => Marble -> St.State c ()
+insertMarble m = St.modify $ game . gameMarbles %~ (m <|)
+
+removeMarble :: (HasGame c) => St.State c Marble
+removeMarble = St.state $ game . gameMarbles %%~ \case
+   x :< s' -> (x, s')
+
+addScore :: (HasGame c) => Int -> St.State c ()
+addScore delta = St.modify $ game . gamePlayers . _head +~ delta
+
+newGame nPlayers = Game
+   { _gameMarbles = Seq.singleton 0
+   , _gamePlayers = Seq.replicate nPlayers 0
+   }
+
+runGame :: Int -> Int -> Game
+runGame nPlayers lastMarble = flip St.execState (newGame nPlayers) $ do
+   St.forM_ [1..lastMarble] $ \marble -> do
+      --St.get >>= traceM . show
+      if marble `mod` 23 /= 0
+      then rotateCCW 2 *> insertMarble marble
+      else do
+         addScore marble
+         rotateCW 7
+         m <- removeMarble
+         addScore m
+      nextPlayer
+
+main :: IO ()
+--main = print $ runGame 9 25
+--main = print $ maximum $ view gamePlayers $ runGame 416 71617
+main = print $ maximum $ view gamePlayers $ runGame 416 7161700