Day 22

22.txt

@@ -0,0 +1,25 @@
+##########..#.###...##..#
+##....#...#....#..####.#.
+#..#.##..#..##.###..#.###
+.#.#.......####.....#.#..
+...######....#.##########
+##.#.....#.#####.#....###
+#.####.#..#.#.#...#.#..##
+#.##..#####..###..###.##.
+#.####.#.##.##...#.#.#.##
+#.#.#......##.##..###.#.#
+#...#.#..#.##....#.##..##
+.#.....##.##..#.####..##.
+.#......#.#.########..###
+##....###.#.#.###...##..#
+..##.###....#.....#...#.#
+....##...##...##.##.#..##
+..#.#.#..#######..###..##
+......#####.#####..#.#..#
+.####.#......#..###..#.##
+#....####.#..#.##.###.##.
+####.#...##....###...#.#.
+#####.#......#.#..###.##.
+#.##.#..#..#..#.....#.#.#
+#...#.#.##.#.####.#.#..#.
+.##.##..#..###.##.....###

22a.hs

@@ -0,0 +1,37 @@
+import Data.HashMap.Strict (HashMap, lookupDefault, insert, empty)
+
+data Direction = North | East | South | West deriving Enum
+type Grid = HashMap (Int, Int) Char
+type State = (Grid, (Int, Int), Direction, Int)
+(%) = mod
+
+changeDirection :: Char -> Direction -> Direction
+changeDirection c = case c of
+    '#' -> toEnum . (%4) . (+1) . fromEnum
+    '.' -> toEnum . (%4) . (+3) . fromEnum
+
+incrementPosition :: Direction -> (Int, Int) -> (Int, Int)
+incrementPosition dir (x, y) = case dir of
+    North -> (x, y - 1)
+    East  -> (x + 1, y)
+    South -> (x, y + 1)
+    West  -> (x - 1, y)
+
+nextState :: State -> State
+nextState (grid, pos, dir, count) =
+    let currNode = lookupDefault '.' pos grid
+        newDir   = changeDirection currNode dir
+        newGrid  = insert pos (if currNode == '.' then '#' else '.') grid
+        newPos   = incrementPosition newDir pos
+        newCount = count + if currNode == '.' then 1 else 0
+    in  (newGrid, newPos, newDir, newCount)
+
+parseRow :: (Int, [(Int, Char)]) -> Grid -> Grid
+parseRow (y, xs) grid = foldr (\(x, c) currGrid -> insert (x, y) c currGrid) grid xs
+
+main :: IO ()
+main = do
+    input <- readFile "22.txt"
+    let grid = foldr parseRow empty $ zip [-12..12] . map (zip [-12..12]) . lines $ input
+        (_, _, _, count) = iterate nextState (grid, (0, 0), North, 0) !! 10000
+    print $ count

22b.hs

@@ -0,0 +1,50 @@
+{-# LANGUAGE BangPatterns #-}
+import Data.HashMap.Strict (HashMap, lookupDefault, insert, empty)
+
+data Direction = North | East | South | West deriving Enum
+type Grid = HashMap (Int, Int) Char
+type State = (Grid, (Int, Int), Direction, Int)
+(%) = mod
+
+changeDirection :: Char -> Direction -> Direction
+changeDirection c = case c of
+    '#' -> toEnum . (%4) . (+1) . fromEnum
+    'F' -> toEnum . (%4) . (+2) . fromEnum
+    '.' -> toEnum . (%4) . (+3) . fromEnum
+    'W' -> id
+
+changeNode :: Char -> Char
+changeNode c = case c of
+    '.' -> 'W'
+    'W' -> '#'
+    '#' -> 'F'
+    'F' -> '.'
+
+incrementPosition :: Direction -> (Int, Int) -> (Int, Int)
+incrementPosition dir (x, y) = case dir of
+    North -> (x, y - 1)
+    East  -> (x + 1, y)
+    South -> (x, y + 1)
+    West  -> (x - 1, y)
+
+nextState :: State -> State
+nextState (grid, pos, dir, count) =
+    let currNode = lookupDefault '.' pos grid
+        newDir   = changeDirection currNode dir
+        newGrid  = insert pos (changeNode currNode) grid
+        newPos   = incrementPosition newDir pos
+        !newCount = count + if currNode == 'W' then 1 else 0
+    in  (newGrid, newPos, newDir, newCount)
+
+stricterate :: Int -> State -> Int
+stricterate 0 (_, _, _, count) = count
+stricterate n state = let !next = nextState state in stricterate (n-1) next
+
+parseRow :: (Int, [(Int, Char)]) -> Grid -> Grid
+parseRow (y, xs) grid = foldr (\(x, c) currGrid -> insert (x, y) c currGrid) grid xs
+
+main :: IO ()
+main = do
+    input <- readFile "22.txt"
+    let grid = foldr parseRow empty $ zip [-12..12] . map (zip [-12..12]) . lines $ input
+    print $ stricterate 10000000 (grid, (0, 0), North, 0)

README.md

@@ -30,9 +30,10 @@ These are the runtimes of only one trial but the variances are fairly small and
 | 19  |  0.026      |
 | 20  |  0.168      |
 | 21  |  4.013      |
+| 22  | 12.867      |  7.880
 
 Problems that should be optimized further: 15
 
-Problems that could use some work: 05, 14, 21
+Problems that could use some work: 05, 22, 14, 21
 
 Problems that are good enough with optimizations: 17, 13