From d49d65f5215310b9271d959631df8c5c62a43f59 Mon Sep 17 00:00:00 2001 From: Neil Smith Date: Mon, 10 Dec 2018 14:20:07 +0000 Subject: [PATCH] Done day 9 --- advent-of-code.cabal | 28 ++++- data/advent09.txt | 1 + problems/day09.html | 164 +++++++++++++++++++++++++++ src/advent08/advent08-foldable.hs | 75 ++++++++++++ src/advent08/advent08-treelibrary.hs | 66 +++++++++++ src/advent09/advent09-pointlist.hs | 132 +++++++++++++++++++++ src/advent09/advent09.hs | 132 +++++++++++++++++++++ 7 files changed, 597 insertions(+), 1 deletion(-) create mode 100644 data/advent09.txt create mode 100644 problems/day09.html create mode 100644 src/advent08/advent08-foldable.hs create mode 100644 src/advent08/advent08-treelibrary.hs create mode 100644 src/advent09/advent09-pointlist.hs create mode 100644 src/advent09/advent09.hs diff --git a/advent-of-code.cabal b/advent-of-code.cabal index 587e98c..2ccee5c 100644 --- a/advent-of-code.cabal +++ b/advent-of-code.cabal @@ -83,4 +83,30 @@ executable advent08 default-language: Haskell2010 build-depends: base >= 4.7 && < 5 , text - , megaparsec \ No newline at end of file + , megaparsec + +-- executable advent08foldable +-- hs-source-dirs: src/advent08 +-- main-is: advent08-foldable.hs +-- default-language: Haskell2010 +-- build-depends: base >= 4.7 && < 5 +-- , text +-- , megaparsec + +executable advent08tree + hs-source-dirs: src/advent08 + main-is: advent08-treelibrary.hs + default-language: Haskell2010 + build-depends: base >= 4.7 && < 5 + , text + , megaparsec + , containers + +executable advent09 + hs-source-dirs: src/advent09 + main-is: advent09.hs + default-language: Haskell2010 + build-depends: base >= 4.7 && < 5 + , text + , megaparsec + , containers diff --git a/data/advent09.txt b/data/advent09.txt new file mode 100644 index 0000000..f9ac5f9 --- /dev/null +++ b/data/advent09.txt @@ -0,0 +1 @@ +458 players; last marble is worth 71307 points diff --git a/problems/day09.html b/problems/day09.html new file mode 100644 index 0000000..3a572e8 --- /dev/null +++ b/problems/day09.html @@ -0,0 +1,164 @@ + + + + +Day 9 - Advent of Code 2018 + + + + + + + +

Advent of Code

Neil Smith (AoC++) 18*

   <y>2018</y>

+ + + +
+

--- Day 9: Marble Mania ---

You talk to the Elves while you wait for your navigation system to initialize. To pass the time, they introduce you to their favorite marble game.

+

The Elves play this game by taking turns arranging the marbles in a circle according to very particular rules. The marbles are numbered starting with 0 and increasing by 1 until every marble has a number.

+

First, the marble numbered 0 is placed in the circle. At this point, while it contains only a single marble, it is still a circle: the marble is both clockwise from itself and counter-clockwise from itself. This marble is designated the current marble.

+

Then, each Elf takes a turn placing the lowest-numbered remaining marble into the circle between the marbles that are 1 and 2 marbles clockwise of the current marble. (When the circle is large enough, this means that there is one marble between the marble that was just placed and the current marble.) The marble that was just placed then becomes the current marble.

+

However, if the marble that is about to be placed has a number which is a multiple of 23, something entirely different happens. First, the current player keeps the marble they would have placed, adding it to their score. In addition, the marble 7 marbles counter-clockwise from the current marble is removed from the circle and also added to the current player's score. The marble located immediately clockwise of the marble that was removed becomes the new current marble.

+

For example, suppose there are 9 players. After the marble with value 0 is placed in the middle, each player (shown in square brackets) takes a turn. The result of each of those turns would produce circles of marbles like this, where clockwise is to the right and the resulting current marble is in parentheses:

+
[-] (0)
+[1]  0 (1)
+[2]  0 (2) 1 
+[3]  0  2  1 (3)
+[4]  0 (4) 2  1  3 
+[5]  0  4  2 (5) 1  3 
+[6]  0  4  2  5  1 (6) 3 
+[7]  0  4  2  5  1  6  3 (7)
+[8]  0 (8) 4  2  5  1  6  3  7 
+[9]  0  8  4 (9) 2  5  1  6  3  7 
+[1]  0  8  4  9  2(10) 5  1  6  3  7 
+[2]  0  8  4  9  2 10  5(11) 1  6  3  7 
+[3]  0  8  4  9  2 10  5 11  1(12) 6  3  7 
+[4]  0  8  4  9  2 10  5 11  1 12  6(13) 3  7 
+[5]  0  8  4  9  2 10  5 11  1 12  6 13  3(14) 7 
+[6]  0  8  4  9  2 10  5 11  1 12  6 13  3 14  7(15)
+[7]  0(16) 8  4  9  2 10  5 11  1 12  6 13  3 14  7 15 
+[8]  0 16  8(17) 4  9  2 10  5 11  1 12  6 13  3 14  7 15 
+[9]  0 16  8 17  4(18) 9  2 10  5 11  1 12  6 13  3 14  7 15 
+[1]  0 16  8 17  4 18  9(19) 2 10  5 11  1 12  6 13  3 14  7 15 
+[2]  0 16  8 17  4 18  9 19  2(20)10  5 11  1 12  6 13  3 14  7 15 
+[3]  0 16  8 17  4 18  9 19  2 20 10(21) 5 11  1 12  6 13  3 14  7 15 
+[4]  0 16  8 17  4 18  9 19  2 20 10 21  5(22)11  1 12  6 13  3 14  7 15 
+[5]  0 16  8 17  4 18(19) 2 20 10 21  5 22 11  1 12  6 13  3 14  7 15 
+[6]  0 16  8 17  4 18 19  2(24)20 10 21  5 22 11  1 12  6 13  3 14  7 15 
+[7]  0 16  8 17  4 18 19  2 24 20(25)10 21  5 22 11  1 12  6 13  3 14  7 15
+
+

The goal is to be the player with the highest score after the last marble is used up. Assuming the example above ends after the marble numbered 25, the winning score is 23+9=32 (because player 5 kept marble 23 and removed marble 9, while no other player got any points in this very short example game).

+

Here are a few more examples:

+
    +
  • 10 players; last marble is worth 1618 points: high score is 8317
    • +
  • 13 players; last marble is worth 7999 points: high score is 146373
    • +
  • 17 players; last marble is worth 1104 points: high score is 2764
    • +
  • 21 players; last marble is worth 6111 points: high score is 54718
    • +
  • 30 players; last marble is worth 5807 points: high score is 37305
    • +
+

What is the winning Elf's score?

+
+

Your puzzle answer was 398048.

--- Part Two ---

Amused by the speed of your answer, the Elves are curious:

+

What would the new winning Elf's score be if the number of the last marble were 100 times larger?

+
+

Your puzzle answer was 3180373421.

Both parts of this puzzle are complete! They provide two gold stars: **

+

At this point, you should return to your advent calendar and try another puzzle.

+

If you still want to see it, you can get your puzzle input.

+

You can also this puzzle.

+
+ + + + + + \ No newline at end of file diff --git a/src/advent08/advent08-foldable.hs b/src/advent08/advent08-foldable.hs new file mode 100644 index 0000000..0fcc76b --- /dev/null +++ b/src/advent08/advent08-foldable.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- import Data.List + +import Data.Monoid +import Data.Text (Text) +import qualified Data.Text.IO as TIO + +import Data.Void (Void) + +import Text.Megaparsec +import Text.Megaparsec.Char +import qualified Text.Megaparsec.Char.Lexer as L +import qualified Control.Applicative as CA + + +data Tree a = Node [Tree a] a deriving (Eq, Show) + +instance Foldable Tree where + foldMap f (Node (t: ts) m) = f m <> foldMap (foldMap f) ts + + +main :: IO () +main = do + text <- TIO.readFile "data/advent08-small.txt" + let treeSpec = successfulParse text + let (tree, _) = parseTree treeSpec + print $ foldMap id tree + print $ part1 tree + print $ part2 tree + +-- part1 = foldMap sum +part1 = metadataOfTree + +part2 = valueOfTree + + +parseTree (c:m:spec) = (Node children metadata, remainder') + where (children, remainder) = parseManyTree c spec + metadata = take m remainder + remainder' = drop m remainder + +parseManyTree n spec + | n == 0 = ([], spec) + | otherwise = ((tree:otherTrees), remainder') + where (tree, remainder) = parseTree spec + (otherTrees, remainder') = parseManyTree (n-1) remainder + +metadataOfTree (Node trees metadata) = metadata ++ (concatMap metadataOfTree trees) + +valueOfTree (Node trees metadata) + | null trees = sum metadata + | otherwise = sum selectedValues + where childValues = map valueOfTree trees + selectedValues = map (\v -> childValues!!(v-1)) $ filter (<= (length trees)) metadata + + +-- Parse the input file + +type Parser = Parsec Void Text + +sc :: Parser () +sc = L.space (skipSome spaceChar) CA.empty CA.empty +-- sc = L.space (skipSome (char ' ')) CA.empty CA.empty + +lexeme = L.lexeme sc +integer = lexeme L.decimal + +treeFileP = many integer + +successfulParse :: Text -> [Int] +successfulParse input = + case parse treeFileP "input" input of + Left _error -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err + Right treeSpec -> treeSpec \ No newline at end of file diff --git a/src/advent08/advent08-treelibrary.hs b/src/advent08/advent08-treelibrary.hs new file mode 100644 index 0000000..19a6ce8 --- /dev/null +++ b/src/advent08/advent08-treelibrary.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- import Data.List + +import Data.Tree (Tree(Node), rootLabel, subForest) + +import Data.Text (Text) +import qualified Data.Text.IO as TIO + +import Data.Void (Void) + +import Text.Megaparsec +import Text.Megaparsec.Char +import qualified Text.Megaparsec.Char.Lexer as L +import qualified Control.Applicative as CA + +main :: IO () +main = do + text <- TIO.readFile "data/advent08-small.txt" + let treeSpec = successfulParse text + let (tree, _) = parseTree treeSpec + -- print $ foldMap sum tree + print $ part1 tree + print $ part2 tree + +part1 = sum . fmap sum + +part2 = valueOfTree + + +parseTree (c:m:spec) = (Node metadata children, remainder') + where (children, remainder) = parseManyTree c spec + metadata = take m remainder + remainder' = drop m remainder + +parseManyTree n spec + | n == 0 = ([], spec) + | otherwise = ((tree:otherTrees), remainder') + where (tree, remainder) = parseTree spec + (otherTrees, remainder') = parseManyTree (n-1) remainder + +valueOfTree (Node metadata trees) + | null trees = sum metadata + | otherwise = sum selectedValues + where childValues = map valueOfTree trees + selectedValues = map (\v -> childValues!!(v-1)) $ filter (<= (length trees)) metadata + + +-- Parse the input file + +type Parser = Parsec Void Text + +sc :: Parser () +sc = L.space (skipSome spaceChar) CA.empty CA.empty +-- sc = L.space (skipSome (char ' ')) CA.empty CA.empty + +lexeme = L.lexeme sc +integer = lexeme L.decimal + +treeFileP = many integer + +successfulParse :: Text -> [Int] +successfulParse input = + case parse treeFileP "input" input of + Left _error -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err + Right treeSpec -> treeSpec \ No newline at end of file diff --git a/src/advent09/advent09-pointlist.hs b/src/advent09/advent09-pointlist.hs new file mode 100644 index 0000000..0cae08b --- /dev/null +++ b/src/advent09/advent09-pointlist.hs @@ -0,0 +1,132 @@ +{-# LANGUAGE OverloadedStrings, ViewPatterns, PatternSynonyms #-} + +import Data.List + +import Data.Foldable (toList) + +import Data.Text (Text) +import qualified Data.Text.IO as TIO + +import Data.Void (Void) + +import Text.Megaparsec +import Text.Megaparsec.Char +import qualified Text.Megaparsec.Char.Lexer as L +import qualified Control.Applicative as CA + +-- import Data.Map.Strict ((!)) +import qualified Data.Map.Strict as M + +import qualified Data.Sequence as Q +import Data.Sequence ((<|), (|>), ViewL((:<)), ViewR((:>)) ) + +-- zipper of left, current, right +data Circle = Circle (Q.Seq Integer) Integer (Q.Seq Integer) deriving (Eq) +type Score = M.Map Integer Integer -- player -> score +data Game = Game Circle Score deriving (Show, Eq) + +instance Show Circle where + show (Circle left current right) = (showSide left) ++ " (" ++ (show current) ++ ") " ++ (showSide right) + where showSide s = intercalate " " $ map show $ toList s + +main :: IO () +main = do + text <- TIO.readFile "data/advent09.txt" + let (numberOfPlayers, numberOfMarbles) = successfulParse text + -- let numberOfPlayers = 10 + -- let numberOfMarbles = 1618 + -- print $ take 5 $ scanl (\c n -> insertAfter n $ stepClockwise c) (createCircle 0) [1..] + -- print $ playGame numberOfPlayers numberOfMarbles + -- print (let p = 10 ; m = 1618 in part1 p m) + -- print (let p = 13 ; m = 7999 in part1 p m) + -- print (let p = 17 ; m = 1104 in part1 p m) + -- print (let p = 21 ; m = 6111 in part1 p m) + -- print (let p = 30 ; m = 5807 in part1 p m) + print $ part1 numberOfPlayers numberOfMarbles + print $ part1 numberOfPlayers (numberOfMarbles * 100) + + + -- putStrLn $ part1 schedule + -- print $ part2 schedule + +part1 players marbles = highScore $ playGame players marbles + +playGame :: Integer -> Integer -> Game +-- playGame players marbles = scanl makeMove createGame $ zip (cycle [1..players]) [1..marbles] +playGame players marbles = foldl' makeMove createGame $ zip (cycle [1..players]) [1..marbles] + +highScore :: Game -> Integer +highScore (Game _ score) = maximum $ M.elems score + +createGame :: Game +createGame = Game (createCircle 0) M.empty + +createCircle :: Integer -> Circle +createCircle current = Circle Q.empty current Q.empty + +currentMarble :: Circle -> Integer +currentMarble (Circle _ m _) = m + +stepClockwise :: Circle -> Circle +stepClockwise (Circle left current right) + | (Q.null left) && (Q.null right) = Circle left current right + | (Q.null right) = stepClockwise (Circle Q.empty current left) + | otherwise = Circle (left |> current) r rs + where (r :< rs) = Q.viewl right + +stepAntiClockwise :: Circle -> Circle +stepAntiClockwise (Circle left current right) + | (Q.null left) && (Q.null right) = Circle left current right + | (Q.null left) = stepAntiClockwise (Circle right current Q.empty) + | otherwise = Circle ls l (current <| right) + where (ls :> l) = Q.viewr left + +insertAfter :: Integer -> Circle -> Circle +insertAfter new (Circle left current right) = Circle (left |> current) new right + +removeCurrent :: Circle -> Circle +removeCurrent (Circle left _ right) + | Q.null right = Circle ls l Q.empty + | otherwise = Circle left r rs + where (l :< ls) = Q.viewl left + (r :< rs) = Q.viewl right + +makeMove :: Game -> (Integer, Integer) -> Game +makeMove (Game circle score) (player, marble) = + if marble `mod` 23 == 0 + then let circle' = (iterate stepAntiClockwise circle) !! 7 + score' = updateScore score player (marble + (currentMarble circle')) + circle'' = removeCurrent circle' + in Game circle'' score' + else let circle' = insertAfter marble (stepClockwise circle) + in Game circle' score + +updateScore :: Score -> Integer -> Integer -> Score +updateScore score player change = M.insert player (current + change) score + where current = M.findWithDefault 0 player score + + +-- Parse the input file + +type Parser = Parsec Void Text + +sc :: Parser () +sc = L.space (skipSome spaceChar) CA.empty CA.empty + +lexeme = L.lexeme sc +integer = lexeme L.decimal +symb = L.symbol sc + +infixP = symb "players; last marble is worth" +suffixP = symb "points" + + +-- linkP = pairify <$> prefixP <*> upperChar <* infixP <*> upperChar <* suffixP +-- where pairify _ a b = (a, b) +gameFileP = (,) <$> integer <* infixP <*> integer <* suffixP + +successfulParse :: Text -> (Integer, Integer) +successfulParse input = + case parse gameFileP "input" input of + Left _error -> (0, 0) -- TIO.putStr $ T.pack $ parseErrorPretty err + Right game -> game \ No newline at end of file diff --git a/src/advent09/advent09.hs b/src/advent09/advent09.hs new file mode 100644 index 0000000..0cae08b --- /dev/null +++ b/src/advent09/advent09.hs @@ -0,0 +1,132 @@ +{-# LANGUAGE OverloadedStrings, ViewPatterns, PatternSynonyms #-} + +import Data.List + +import Data.Foldable (toList) + +import Data.Text (Text) +import qualified Data.Text.IO as TIO + +import Data.Void (Void) + +import Text.Megaparsec +import Text.Megaparsec.Char +import qualified Text.Megaparsec.Char.Lexer as L +import qualified Control.Applicative as CA + +-- import Data.Map.Strict ((!)) +import qualified Data.Map.Strict as M + +import qualified Data.Sequence as Q +import Data.Sequence ((<|), (|>), ViewL((:<)), ViewR((:>)) ) + +-- zipper of left, current, right +data Circle = Circle (Q.Seq Integer) Integer (Q.Seq Integer) deriving (Eq) +type Score = M.Map Integer Integer -- player -> score +data Game = Game Circle Score deriving (Show, Eq) + +instance Show Circle where + show (Circle left current right) = (showSide left) ++ " (" ++ (show current) ++ ") " ++ (showSide right) + where showSide s = intercalate " " $ map show $ toList s + +main :: IO () +main = do + text <- TIO.readFile "data/advent09.txt" + let (numberOfPlayers, numberOfMarbles) = successfulParse text + -- let numberOfPlayers = 10 + -- let numberOfMarbles = 1618 + -- print $ take 5 $ scanl (\c n -> insertAfter n $ stepClockwise c) (createCircle 0) [1..] + -- print $ playGame numberOfPlayers numberOfMarbles + -- print (let p = 10 ; m = 1618 in part1 p m) + -- print (let p = 13 ; m = 7999 in part1 p m) + -- print (let p = 17 ; m = 1104 in part1 p m) + -- print (let p = 21 ; m = 6111 in part1 p m) + -- print (let p = 30 ; m = 5807 in part1 p m) + print $ part1 numberOfPlayers numberOfMarbles + print $ part1 numberOfPlayers (numberOfMarbles * 100) + + + -- putStrLn $ part1 schedule + -- print $ part2 schedule + +part1 players marbles = highScore $ playGame players marbles + +playGame :: Integer -> Integer -> Game +-- playGame players marbles = scanl makeMove createGame $ zip (cycle [1..players]) [1..marbles] +playGame players marbles = foldl' makeMove createGame $ zip (cycle [1..players]) [1..marbles] + +highScore :: Game -> Integer +highScore (Game _ score) = maximum $ M.elems score + +createGame :: Game +createGame = Game (createCircle 0) M.empty + +createCircle :: Integer -> Circle +createCircle current = Circle Q.empty current Q.empty + +currentMarble :: Circle -> Integer +currentMarble (Circle _ m _) = m + +stepClockwise :: Circle -> Circle +stepClockwise (Circle left current right) + | (Q.null left) && (Q.null right) = Circle left current right + | (Q.null right) = stepClockwise (Circle Q.empty current left) + | otherwise = Circle (left |> current) r rs + where (r :< rs) = Q.viewl right + +stepAntiClockwise :: Circle -> Circle +stepAntiClockwise (Circle left current right) + | (Q.null left) && (Q.null right) = Circle left current right + | (Q.null left) = stepAntiClockwise (Circle right current Q.empty) + | otherwise = Circle ls l (current <| right) + where (ls :> l) = Q.viewr left + +insertAfter :: Integer -> Circle -> Circle +insertAfter new (Circle left current right) = Circle (left |> current) new right + +removeCurrent :: Circle -> Circle +removeCurrent (Circle left _ right) + | Q.null right = Circle ls l Q.empty + | otherwise = Circle left r rs + where (l :< ls) = Q.viewl left + (r :< rs) = Q.viewl right + +makeMove :: Game -> (Integer, Integer) -> Game +makeMove (Game circle score) (player, marble) = + if marble `mod` 23 == 0 + then let circle' = (iterate stepAntiClockwise circle) !! 7 + score' = updateScore score player (marble + (currentMarble circle')) + circle'' = removeCurrent circle' + in Game circle'' score' + else let circle' = insertAfter marble (stepClockwise circle) + in Game circle' score + +updateScore :: Score -> Integer -> Integer -> Score +updateScore score player change = M.insert player (current + change) score + where current = M.findWithDefault 0 player score + + +-- Parse the input file + +type Parser = Parsec Void Text + +sc :: Parser () +sc = L.space (skipSome spaceChar) CA.empty CA.empty + +lexeme = L.lexeme sc +integer = lexeme L.decimal +symb = L.symbol sc + +infixP = symb "players; last marble is worth" +suffixP = symb "points" + + +-- linkP = pairify <$> prefixP <*> upperChar <* infixP <*> upperChar <* suffixP +-- where pairify _ a b = (a, b) +gameFileP = (,) <$> integer <* infixP <*> integer <* suffixP + +successfulParse :: Text -> (Integer, Integer) +successfulParse input = + case parse gameFileP "input" input of + Left _error -> (0, 0) -- TIO.putStr $ T.pack $ parseErrorPretty err + Right game -> game \ No newline at end of file -- 2.34.1