diff --git a/Day5/Part2.hs b/Day5/Part2.hs index 479a2fa..e68b242 100755 --- a/Day5/Part2.hs +++ b/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) diff --git a/Day9/Part1.hs b/Day9/Part1.hs new file mode 100755 index 0000000..104a7d9 --- /dev/null +++ b/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 diff --git a/Day9/Part2.hs b/Day9/Part2.hs new file mode 100755 index 0000000..b154fd3 --- /dev/null +++ b/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