src/advent09/advent09-pointlist.hs

   1 {-# LANGUAGE OverloadedStrings, ViewPatterns, PatternSynonyms #-}
   2
   3 import Data.List
   4
   5 import Data.Maybe (fromJust)
   6
   7 import Data.Text (Text)
   8 import qualified Data.Text.IO as TIO
   9
  10 import Data.Void (Void)
  11
  12 import Text.Megaparsec
  13 import Text.Megaparsec.Char
  14 import qualified Text.Megaparsec.Char.Lexer as L
  15 import qualified Control.Applicative as CA
  16
  17 -- import Data.Map.Strict ((!))
  18 import qualified Data.Map.Strict as M
  19
  20 import Data.List.PointedList (PointedList)
  21 import qualified Data.List.PointedList.Circular as PL
  22
  23 type Circle = PointedList Integer
  24 type Score = M.Map Integer Integer -- player -> score
  25 data Game = Game Circle Score deriving (Show, Eq)
  26
  27 main :: IO ()
  28 main = do
  29         text <- TIO.readFile "data/advent09.txt"
  30         let (numberOfPlayers, numberOfMarbles) = successfulParse text
  31         print $ part1 numberOfPlayers numberOfMarbles
  32         print $ part1 numberOfPlayers (numberOfMarbles * 100)
  33
  34 part1 :: Integer -> Integer -> Integer
  35 part1 players marbles = highScore $ playGame players marbles
  36
  37 playGame :: Integer -> Integer -> Game
  38 -- playGame players marbles = scanl makeMove createGame $ zip (cycle [1..players]) [1..marbles]
  39 playGame players marbles = foldl' makeMove createGame $ zip (cycle [1..players]) [1..marbles]
  40
  41 highScore :: Game -> Integer
  42 highScore (Game _ score) = maximum $ M.elems score
  43
  44 createGame :: Game
  45 createGame = Game (createCircle 0) M.empty
  46
  47 createCircle :: Integer -> Circle
  48 createCircle current = PL.singleton current
  49
  50
  51 makeMove :: Game -> (Integer, Integer) -> Game
  52 makeMove (Game circle score) (player, marble) =
  53     if marble `mod` 23 == 0
  54     then let circle' = (iterate PL.previous circle) !! 7
  55              score' = updateScore score player (marble + (PL._focus circle'))
  56              circle'' = fromJust $ PL.deleteRight circle'
  57          in Game circle'' score'
  58     else let circle' = PL.insertRight marble (PL.next circle)
  59          in Game circle' score
  60
  61 updateScore :: Score -> Integer -> Integer -> Score
  62 updateScore score player change = M.insert player (current + change) score
  63     where current = M.findWithDefault 0 player score
  64
  65
  66 -- Parse the input file
  67
  68 type Parser = Parsec Void Text
  69
  70 sc :: Parser ()
  71 sc = L.space (skipSome spaceChar) CA.empty CA.empty
  72
  73 lexeme  = L.lexeme sc
  74 integer = lexeme L.decimal
  75 symb = L.symbol sc
  76
  77 infixP = symb "players; last marble is worth"
  78 suffixP = symb "points"
  79
  80
  81 -- linkP = pairify <$> prefixP <*> upperChar <* infixP <*> upperChar <* suffixP
  82 --     where pairify _ a b = (a, b)
  83 gameFileP = (,) <$> integer <* infixP <*> integer <* suffixP
  84
  85 successfulParse :: Text -> (Integer, Integer)
  86 successfulParse input =
  87         case parse gameFileP "input" input of
  88                 Left  _error -> (0, 0) -- TIO.putStr $ T.pack $ parseErrorPretty err
  89                 Right game -> game