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
|
{-# LANGUAGE MultiWayIf #-}
module Main where
import qualified Data.Array as A
import Data.List (findIndex)
import Data.Maybe (fromJust)
import Data.Monoid (Sum(..))
import Input
stencil8 :: a -> (a -> [a] -> b) -> A.Array (Int, Int) a -> A.Array (Int, Int) b
stencil8 def f arr =
A.listArray (A.bounds arr)
[f (arr A.! (y, x))
[get (yi, xi)
| yi <- [y-1 .. y+1]
, xi <- [x-1 .. x+1]
, xi /= 0 || yi /= 0]
| y <- [y1..y2], x <- [x1..x2]]
where
get (y, x) | y1 <= y, y <= y2, x1 <= x, x <= x2 = arr A.! (y, x)
| otherwise = def
((y1, x1), (y2, x2)) = A.bounds arr
amap :: A.Ix i => (a -> b) -> A.Array i a -> A.Array i b
amap f a = A.listArray (A.bounds a) (map f (A.elems a))
flash :: A.Array (Int, Int) Int -> A.Array (Int, Int) Int
flash = stencil8 0 $ \v env -> if | v < 0 -> v
| v > 9 -> -1
| otherwise -> v + sum (map (fromEnum . (>9)) env)
step :: A.Array (Int, Int) Int -> (Sum Int, A.Array (Int, Int) Int)
step a =
let a' = fixpoint flash (amap (+1) a)
in (Sum (length [() | -1 <- A.elems a']), amap (\v -> if v < 0 then 0 else v) a')
where fixpoint f x = let y = f x in if y == x then x else fixpoint f y
display :: A.Array (Int, Int) Int -> String
display arr = unlines
[concat [show (arr A.! (y, x)) | x <- [x1..x2]] | y <- [y1..y2]]
where ((y1, x1), (y2, x2)) = A.bounds arr
main :: IO ()
main = do
inp <- getInput 11
let arr0 = A.listArray ((1, 1), (length inp, length (head inp))) (concatMap (map (read . pure)) inp)
let states = iterate (>>= step) (return arr0)
print (getSum (fst (states !! 100)))
print (fromJust $ findIndex (all (== 0) . A.elems) (map snd states))
|
