From 15d597662b7cd5eb950ecf30ddb452cd1f247bf8 Mon Sep 17 00:00:00 2001
From: Yuchen Pei <me@ypei.me>
Date: Sat, 23 Dec 2017 10:41:50 +0100
Subject: finished Day 22

---
 Puzzle22.hs | 92 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 92 insertions(+)
 create mode 100644 Puzzle22.hs

(limited to 'Puzzle22.hs')

diff --git a/Puzzle22.hs b/Puzzle22.hs
new file mode 100644
index 0000000..0b9df4d
--- /dev/null
+++ b/Puzzle22.hs
@@ -0,0 +1,92 @@
+{-# LANGUAGE BangPatterns #-}
+
+import Data.Map (Map)
+import qualified Data.Map as Map
+
+data Direction = U | R | D | L
+data Status = Infected | Clean | Weakened | Flagged deriving Eq
+
+step :: Int -> Int -> Map (Int, Int) Bool -> (Int, Int) -> Direction -> Int
+step n m cluster (x, y) dir
+  | n == 0 = m
+  | otherwise = step (n - 1) (m + (if infected then 0 else 1)) (Map.insert (x, y) (not infected) cluster) (x', y') dir'
+    where infected = Map.findWithDefault False (x, y) cluster
+          dir' = f infected dir
+          (x', y') = g (x, y) dir'
+
+step' :: Int -> Int -> Map (Int, Int) Status -> (Int, Int) -> Direction -> Int
+step' !n !m !cluster (!x, !y) !dir
+  | n == 0 = m
+  | otherwise = step' (n - 1) m' cluster' (x', y') dir'
+    where status = Map.findWithDefault Clean (x, y) cluster
+          dir' = f' status dir
+          status' = k status
+          cluster' = Map.insert (x, y) status' cluster
+          (x', y') = g (x, y) dir'
+          m' = if status' == Infected then m + 1 else m
+
+f :: Bool -> Direction -> Direction
+f True U = R
+f True R = D
+f True D = L
+f True L = U
+f False U = L
+f False L = D
+f False D = R
+f False R = U
+
+f' Infected U = R
+f' Infected R = D
+f' Infected D = L
+f' Infected L = U
+f' Clean U = L
+f' Clean L = D
+f' Clean D = R
+f' Clean R = U
+f' Weakened x = x
+f' Flagged U = D
+f' Flagged L = R
+f' Flagged D = U
+f' Flagged R = L
+
+k Clean = Weakened
+k Weakened = Infected
+k Infected = Flagged
+k Flagged = Clean
+
+g :: (Int, Int) -> Direction -> (Int, Int)
+g (!x, !y) R = (x, y + 1)
+g (!x, !y) D = (x + 1, y)
+g (!x, !y) L = (x, y - 1)
+g (!x, !y) U = (x - 1, y)
+
+h :: Char -> Bool
+h '.' = False
+h '#' = True
+
+h' :: Char -> Status
+h' '.' = Clean
+h' '#' = Infected
+
+solve2 :: [Char] -> Int
+solve2 xs = step' 10000000 0 cluster initCoord U
+  where mat = (fmap h') <$> lines xs
+        cluster = mat2Map mat
+        initCoord = (length mat `div` 2, length (head mat) `div` 2)
+
+
+solve1 :: [Char] -> Int
+solve1 xs = step 10000 0 cluster initCoord U
+  where mat = (fmap h) <$> lines xs
+        cluster = mat2Map mat
+        initCoord = (length mat `div` 2, length (head mat) `div` 2)
+
+mat2Map :: [[a]] -> Map (Int, Int) a
+mat2Map xs = Map.fromList $ mconcat $ fmap j $ zipWith (,) [0 .. length xs - 1] xs
+  where j (x, ys) = zipWith (,) ((\y -> (x,y)) <$> [0 .. length ys]) ys
+
+input0 = "..#\n#..\n..."
+
+input = "...#.##.#.#.#.#..##.###.#\n......##.....#####..#.#.#\n#..####.######.#.#.##...#\n...##..####........#.#.#.\n.#.#####..#.....#######..\n.#...#.#.##.#.#.....#....\n.#.#.#.#.#####.#.#..#...#\n###..##.###.#.....#...#.#\n#####..#.....###.....####\n#.##............###.#.###\n#...###.....#.#.##.#..#.#\n.#.###.##..#####.....####\n.#...#..#..###.##..#....#\n##.##...###....##.###.##.\n#.##.###.#.#........#.#..\n##......#..###.#######.##\n.#####.##..#..#....##.##.\n###..#...#..#.##..#.....#\n##..#.###.###.#...##...#.\n##..##..##.###..#.##..#..\n...#.#.###..#....##.##.#.\n##.##..####..##.##.##.##.\n#...####.######.#...##...\n.###..##.##..##.####....#\n#.##....#.#.#..#.###..##."
+
+main = putStr $ show $ solve2 input
-- 
cgit v1.2.3