From 746d4f5d9f3b0465933524920b31a1e4da2a0677 Mon Sep 17 00:00:00 2001
From: Sloane Perrault <sloane.perrault@gmail.com>
Date: Mon, 5 Dec 2022 07:58:28 -0500
Subject: [PATCH] wip: 2022 day 5
---
2022/README.md | 3 +-
2022/aoc.cabal | 1 +
2022/app/Main.hs | 2 ++
2022/src/Aoc/Day5.hs | 77 ++++++++++++++++++++++++++++++++++++++++++++
4 files changed, 82 insertions(+), 1 deletion(-)
create mode 100644 2022/src/Aoc/Day5.hs
diff --git a/2022/README.md b/2022/README.md
index a4c8446..783d366 100644
--- a/2022/README.md
+++ b/2022/README.md
@@ -3,7 +3,7 @@
| S | M | T | W | T | F | S |
| :-: | :-: | :-: | :-: | :-: | :-: | :--: |
| | | | | [1] | [2] | [3] |
-| [4] | 5 | 6 | 7 | 8 | 9 | 10 |
+| [4] | [5] | 6 | 7 | 8 | 9 | 10 |
| 11 | 12 | 13 | 14 | 15 | 16 | 17 |
| 18 | 19 | 20 | 21 | 22 | 23 | 24 |
| 24 | | | | | | |
@@ -12,3 +12,4 @@
[2]: ./src/Aoc/Day2.hs
[3]: ./src/Aoc/Day3.hs
[4]: ./src/Aoc/Day4.hs
+[5]: ./src/Aoc/Day5.hs
diff --git a/2022/aoc.cabal b/2022/aoc.cabal
index bbe7c0a..d000c4e 100644
--- a/2022/aoc.cabal
+++ b/2022/aoc.cabal
@@ -30,6 +30,7 @@ library
Aoc.Day2
Aoc.Day3
Aoc.Day4
+ Aoc.Day5
other-modules:
Paths_aoc
hs-source-dirs:
diff --git a/2022/app/Main.hs b/2022/app/Main.hs
index d3ee9ee..1f62862 100644
--- a/2022/app/Main.hs
+++ b/2022/app/Main.hs
@@ -6,6 +6,7 @@ import qualified Aoc.Day1
import qualified Aoc.Day2
import qualified Aoc.Day3
import qualified Aoc.Day4
+import qualified Aoc.Day5
main :: IO ()
main = do
@@ -19,6 +20,7 @@ main = do
2 -> Aoc.Day2.solve
3 -> Aoc.Day3.solve
4 -> Aoc.Day4.solve
+ 5 -> Aoc.Day5.solve
_ -> error "unknown day"
putStrLn $ f part contents
diff --git a/2022/src/Aoc/Day5.hs b/2022/src/Aoc/Day5.hs
new file mode 100644
index 0000000..68b2131
--- /dev/null
+++ b/2022/src/Aoc/Day5.hs
@@ -0,0 +1,77 @@
+module Aoc.Day5 (solve) where
+
+import Aoc (runReadP)
+import Data.Char (isDigit)
+import Data.Maybe
+import Data.List (transpose)
+import Data.IntMap.Strict (IntMap)
+import qualified Data.IntMap.Strict as IntMap
+import Text.ParserCombinators.ReadP
+
+data Crate = A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | R | S | T | U | V | W | X | Y | Z
+ deriving (Read, Show)
+type Stack = [Crate]
+type State = IntMap Stack
+
+data Move = Move { amount :: Int, from :: Int, to :: Int }
+ deriving (Show)
+type Procedure = [Move]
+
+data Input = Input { state :: State, procedure :: Procedure }
+ deriving (Show)
+
+parseMove :: String -> Move
+parseMove = runReadP moveP
+ where
+ intP :: ReadP Int
+ intP = do
+ digits <- munch1 isDigit
+ return $ read digits
+
+ moveP :: ReadP Move
+ moveP = do
+ _ <- string "move "
+ amount' <- intP
+ _ <- string " from "
+ from' <- intP
+ _ <- string " to "
+ to' <- intP
+ return $ Move { amount = amount', from = from', to = to' }
+
+parseInput :: String -> Input
+parseInput input = Input { state = state, procedure = procedure }
+ where
+ -- i hate this
+ stateContents = concat $ transpose $ takeWhile (/= "") $ lines input
+ parseState "" _ state = IntMap.map reverse state
+ parseState (x:xs) acc state
+ | x == '[' || x == ']' || x == ' ' = parseState xs acc state
+ | isDigit x = parseState xs [] $ IntMap.insert (read [x]) acc state
+ | otherwise = parseState xs ((read [x]):acc) state
+ state = parseState stateContents [] IntMap.empty
+
+ procedureContents = drop 1 $ dropWhile (/= "") $ lines input
+ procedure = map parseMove procedureContents
+
+doMove :: Move -> State -> State
+doMove m s = s'
+ where
+ (forTo, backToFrom) = splitAt (amount m) $ fromJust $ IntMap.lookup (from m) s
+ addToTo to' = Just $ (reverse forTo) ++ to'
+ s' = IntMap.update addToTo (to m) $ IntMap.insert (from m) backToFrom s
+
+stackLabel :: Stack -> String
+stackLabel [] = ""
+stackLabel (x:_) = show x
+
+message :: State -> String
+message s = concat $ map stackLabel $ IntMap.elems s
+
+solve :: Integer -> String -> String
+solve 1 input = message $ foldr doMove state' procedure'
+ where
+ input' = parseInput input
+ state' = state input'
+ procedure' = procedure input'
+
+solve _ _ = "?"