1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
-- Author: Yuchen Pei (me@ypei.me)
{-# 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
|
