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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
module Main where
import Control.Monad (foldM)
import Data.Char (digitToInt)
import Data.Either (fromLeft)
import Data.List (foldl', intercalate)
import Data.Map (Map, (!))
import qualified Data.Map as Map
import Debug.Trace (trace, traceShow)
import Utils
type Dim = (Int, Int)
type Point = (Int, Int)
type State = Map Point Int
printState :: Dim -> State -> IO ()
printState dim@(xsize, ysize) state =
let coords = [(x, y) | y <- [0 .. ysize - 1], x <- [0 .. xsize -1]]
elems = coords $> map (state !)
in splitEvery xsize (elems $> map show .> intercalate "")
$> map putStrLn
.> sequence_
pointSum :: Point -> Point -> Point
pointSum (x1, y1) (x2, y2) = (x1 + x2, y1 + y2)
incAllBy1 :: State -> State
incAllBy1 = Map.map (+ 1)
flash :: State -> Dim -> Point -> State
flash state dim@(xsize, ysize) p =
let flashed = neighbors state dim p
in Map.mapWithKey (\p' v -> if p' `elem` flashed then v + 1 else v) state
findOverNine :: State -> [Point] -> Maybe Point
findOverNine state alreadyFlashed =
let ps = Map.filterWithKey (\k v -> v > 9 && k `notElem` alreadyFlashed) state $> Map.keys
in if not (null ps)
then Just (head ps)
else Nothing
resetFlashed :: State -> State
resetFlashed = Map.map (\v -> if v > 9 then 0 else v)
neighbors :: State -> Dim -> Point -> [Point]
neighbors state (xsize, ysize) p@(x, y) =
let diffs = [(dx, dy) | dx <- [-1, 0, 1], dy <- [-1, 0, 1]]
ps = diffs $> map (pointSum p)
in filter (`Map.member` state) ps
flashIfNotYetFlashed :: State -> Dim -> [Point] -> Point -> ([Point], State)
flashIfNotYetFlashed state dim alreadyFlashed p
| p `elem` alreadyFlashed = (alreadyFlashed, state)
| otherwise =
let state' = flash state dim p
in (p : alreadyFlashed, state')
iterateFlashes state dim alreadyFlashed =
let unstableM = findOverNine state alreadyFlashed
in case unstableM of
Nothing -> (length alreadyFlashed, state)
Just p ->
let (alreadyFlashed', state') = flashIfNotYetFlashed state dim alreadyFlashed p
(n, res) = iterateFlashes state' dim alreadyFlashed'
in if length alreadyFlashed' == length alreadyFlashed
then (length alreadyFlashed, state')
else (n, res)
step state dim =
let state' = incAllBy1 state
(flashesN, state'') = iterateFlashes state' dim []
in (flashesN, resetFlashed state'')
e1 :: State -> Dim -> (Int, State)
e1 hmap dim =
foldl'
( \(n, state) _ ->
let (n', state') = step state dim
in (n + n', state')
)
(0, hmap)
[1 .. 100]
e2 :: State -> Dim -> Int
e2 hmap dim@(xsize, ysize) =
foldM
( \state s ->
let (n', state') = step state dim
in if n' == xsize * ysize
then Left s
else Right state'
)
hmap
[1 ..]
$> (\(Left s) -> s)
main :: IO ()
main =
do
contents <- getContents
let input = contents $> lines .> map (map digitToInt)
let dim@(ysize, xsize) = (length input, length (head input))
let coords = [(x, y) | y <- [0 .. ysize - 1], x <- [0 .. xsize -1]]
let hmap = Map.fromList $ zip coords (concat input)
e1 hmap dim $> fst .> print
e2 hmap dim $> print
|
