From 1875db3487ffb78fb53f55d6b0af4381b3dee46f Mon Sep 17 00:00:00 2001 From: Daniel Lin Date: Thu, 22 Dec 2022 11:56:23 -0500 Subject: [PATCH] Day 22: Monkey Map --- README.md | 1 + hs/aoc2022.cabal | 3 ++ hs/app/Main.hs | 2 + hs/bench/Main.hs | 5 ++ hs/src/Day22.hs | 107 +++++++++++++++++++++++++++++++++++++++++++ hs/test/Day22Spec.hs | 34 ++++++++++++++ 6 files changed, 152 insertions(+) create mode 100644 hs/src/Day22.hs create mode 100644 hs/test/Day22Spec.hs diff --git a/README.md b/README.md index 8f41e24..4697de9 100644 --- a/README.md +++ b/README.md @@ -27,3 +27,4 @@ Development occurs in language-specific directories: |[Day19.hs](hs/src/Day19.hs)|[Day19.kt](kt/src/commonMain/kotlin/com/github/ephemient/aoc2022/Day19.kt)|[day19.py](py/aoc2022/day19.py)|[day19.rs](rs/src/day19.rs)| |[Day20.hs](hs/src/Day20.hs)|[Day20.kt](kt/src/commonMain/kotlin/com/github/ephemient/aoc2022/Day20.kt)|[day20.py](py/aoc2022/day20.py)|[day20.rs](rs/src/day20.rs)| |[Day21.hs](hs/src/Day21.hs)|[Day21.kt](kt/src/commonMain/kotlin/com/github/ephemient/aoc2022/Day21.kt)|[day21.py](py/aoc2022/day21.py)|[day21.rs](rs/src/day21.rs)| +|[Day22.hs](hs/src/Day22.hs)| diff --git a/hs/aoc2022.cabal b/hs/aoc2022.cabal index 635e7ef..fd6f918 100644 --- a/hs/aoc2022.cabal +++ b/hs/aoc2022.cabal @@ -32,6 +32,7 @@ data-files: , day19.txt , day20.txt , day21.txt + , day22.txt extra-source-files: README.md @@ -60,6 +61,7 @@ library , Day19 , Day20 , Day21 + , Day22 build-depends: array ^>=0.5.4.0 , base ^>=4.16.0.0 @@ -123,6 +125,7 @@ test-suite aoc2022-test , Day19Spec , Day20Spec , Day21Spec + , Day22Spec hs-source-dirs: test default-language: GHC2021 build-tool-depends: diff --git a/hs/app/Main.hs b/hs/app/Main.hs index d2c0e5f..7c61ce2 100644 --- a/hs/app/Main.hs +++ b/hs/app/Main.hs @@ -23,6 +23,7 @@ import Day18 (day18a, day18b) import Day19 (day19a, day19b) import Day20 (day20a, day20b) import Day21 (day21a, day21b) +import Day22 (day22a, day22b) import Control.Monad ((<=<), ap, when) import Data.Function (on) @@ -73,3 +74,4 @@ main = do run 19 (either (fail . errorBundlePretty) print) [day19a, day19b] run 20 (either fail print) [day20a, day20b] run 21 (either (fail . errorBundlePretty) print) [day21a, day21b] + run 22 print [day22a, day22b] diff --git a/hs/bench/Main.hs b/hs/bench/Main.hs index 3951374..c96fd5f 100644 --- a/hs/bench/Main.hs +++ b/hs/bench/Main.hs @@ -26,6 +26,7 @@ import Day18 (day18a, day18b) import Day19 (day19a, day19b) import Day20 (day20a, day20b) import Day21 (day21a, day21b) +import Day22 (day22a, day22b) import Paths_aoc2022 (getDataFileName) import System.Environment.Blank (getEnv, setEnv, unsetEnv) @@ -126,4 +127,8 @@ main = defaultMain [ bench "part 1" $ nf day21a input , bench "part 2" $ nf day21b input ] + , env (getDayInput 22) $ \input -> bgroup "Day 22" + [ bench "part 1" $ nf day22a input + , bench "part 2" $ nf day22b input + ] ] diff --git a/hs/src/Day22.hs b/hs/src/Day22.hs new file mode 100644 index 0000000..dd494d9 --- /dev/null +++ b/hs/src/Day22.hs @@ -0,0 +1,107 @@ +{-| +Module: Day22 +Description: +-} +{-# LANGUAGE LambdaCase, MultiWayIf, NondecreasingIndentation, OverloadedStrings, ParallelListComp, RecordWildCards, ScopedTypeVariables, TransformListComp, TypeFamilies, ViewPatterns #-} +module Day22 (day22a, day22b) where + +import Control.Arrow (first) +import Data.Either (partitionEithers) +import Data.Function (on) +import Data.Ix (inRange) +import Data.List (find, foldl', foldl1', groupBy) +import Data.List.Split (chunksOf) +import Data.Map (Map) +import qualified Data.Map as Map ((!?), fromList) +import Data.Maybe (fromJust, maybeToList) +import Data.Text (Text) +import qualified Data.Text as T (findIndex, index, length, lines, null, uncons) +import qualified Data.Text.Read as T (decimal) +import Data.Vector (Vector) +import qualified Data.Vector as V ((!), (!?), fromList, head, length) + +data Move a = Move a | TurnL | TurnR +data Dir = R | D | L | U deriving (Enum, Eq, Ord) + +readsPath :: (Integral a) => Text -> ([Move a], Text) +readsPath (T.decimal -> Right (n, s)) = let ~(path, s') = readsPath s in (Move n:path, s') +readsPath (T.uncons -> Just ('L', s)) = let ~(path, s') = readsPath s in (TurnL:path, s') +readsPath (T.uncons -> Just ('R', s)) = let ~(path, s') = readsPath s in (TurnR:path, s') +readsPath s = ([], s) + +turnRight, turn180, turnLeft :: Dir -> Dir +turnRight d = toEnum $ (fromEnum d + 1) `mod` 4 +turn180 d = toEnum $ (fromEnum d + 2) `mod` 4 +turnLeft d = toEnum $ (fromEnum d + 3) `mod` 4 + +step :: (Num a) => Dir -> (a, a) -> (a, a) +step R (x, y) = (x + 1, y) +step D (x, y) = (x, y + 1) +step L (x, y) = (x - 1, y) +step U (x, y) = (x, y - 1) + +get :: Vector Text -> (Int, Int) -> Char +get maze (x, y) + | Just line <- maze V.!? y, inRange (0, T.length line - 1) x = T.index line x + | otherwise = ' ' + +mazePerimeter :: Vector Text -> [((Int, Int), Dir)] +mazePerimeter maze + | Just x0 <- maze V.!? 0 >>= T.findIndex (== '.') + = let initial:rest = iterate step' ((x0, 0), R) in initial:takeWhile (/= initial) rest where + step' (p, d) + | ' ' <- get maze p' = (p, turnRight d) + | ' ' <- get maze p'' = (p', d) + | otherwise = (p'', turnLeft d) + where + p' = step d p + p'' = step (turnLeft d) p' +mazePerimeter _ = [] + +mazeEdges2D, mazeEdges3D :: Vector Text -> Map ((Int, Int), Dir) ((Int, Int), Dir) +mazeEdges2D maze = Map.fromList + [ ((p, d'), (wrap d' p, d')) + | x0 <- maybeToList $ maze V.!? 0 >>= T.findIndex (== '.') + , (p, d) <- mazePerimeter maze + , let d' = turnLeft d + ] where + wrap d (x, y) = fromJust . find ((/= ' ') . get maze) $ case d of + R -> [(x', y) | x' <- [0..x]] + D -> [(x, y') | y' <- [0..y]] + L -> [(x', y) | let line = maze V.! y, x' <- [T.length line - 1, T.length line - 2..x]] + U -> [(x, y') | y' <- [V.length maze - 1, V.length maze - 2..y]] +mazeEdges3D maze = Map.fromList $ concat + [ [((p, turnLeft d), (q, turnRight e)), ((q, turnLeft e), (p, turnRight d))] + | (edge1, edge2) <- joinedEdges + , ((p, d), (q, e)) <- zip edge1 $ reverse edge2 + ] where + perimeter = mazePerimeter maze + sideLength = foldl1' gcd . map length $ groupBy ((==) `on` snd) perimeter + joinEdges [] = [] + joinEdges edges + | [] <- joined = error "loop" + | otherwise = joined ++ joinEdges remaining where + (joined, remaining) = partitionEithers $ joinEdges' edges + joinEdges' ((d1, e1):(d2, e2):edges) + | turnLeft d1 == d2 = Left (e1, e2) : joinEdges' (first turnLeft <$> edges) + joinEdges' (edge:edges) = Right edge : joinEdges' edges + joinEdges' [] = [] + joinedEdges = joinEdges [(dir, edge) | edge@((_, dir):_) <- chunksOf sideLength perimeter] + +day22 :: (Vector Text -> Map ((Int, Int), Dir) ((Int, Int), Dir)) -> Text -> Int +day22 mazeEdges input = 1000 * (y + 1) + 4 * (x + 1) + fromEnum d where + (V.fromList -> maze, [_, readsPath -> (path, "")]) = break T.null $ T.lines input + Just x0 = T.findIndex (== '.') $ V.head maze + edges = mazeEdges maze + step' s | Just s' <- edges Map.!? s = s' + step' (p, d) = (step d p, d) + go s (Move n) = last . takeWhile ((== '.') . get maze . fst) . take (n + 1) $ iterate step' s + go (p, d) TurnL = (p, turnLeft d) + go (p, d) TurnR = (p, turnRight d) + ((x, y), d) = foldl' go ((x0, 0), R) path + +day22a :: Text -> Int +day22a = day22 mazeEdges2D + +day22b :: Text -> Int +day22b = day22 mazeEdges3D diff --git a/hs/test/Day22Spec.hs b/hs/test/Day22Spec.hs new file mode 100644 index 0000000..fe2bf36 --- /dev/null +++ b/hs/test/Day22Spec.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE OverloadedStrings #-} +module Day22Spec (spec) where + +import Data.Text (Text) +import qualified Data.Text as T (unlines) +import Day22 (day22a, day22b) +import Test.Hspec (Spec, describe, it, shouldBe) + +example :: Text +example = T.unlines + [ " ...#" + , " .#.." + , " #..." + , " ...." + , "...#.......#" + , "........#..." + , "..#....#...." + , "..........#." + , " ...#...." + , " .....#.." + , " .#......" + , " ......#." + , "" + , "10R5L5R10L4R5L5" + ] + +spec :: Spec +spec = do + describe "part 1" $ do + it "examples" $ do + day22a example `shouldBe` 6032 + describe "part 2" $ do + it "examples" $ do + day22b example `shouldBe` 5031