module Day11 (day11) where
import Control.Monad (guard)
import Data.Char (digitToInt, isDigit)
import Data.Ix (inRange)
import Data.List (unfoldr)
import Data.List.NonEmpty (NonEmpty((:|)), nonEmpty)
import Data.Text (Text)
import qualified Data.Text as T (all, length, lines, unpack)
import Data.Vector.Unboxed (Unbox, Vector)
import qualified Data.Vector.Unboxed as V (accum, all, findIndex, length, map, fromList)
step :: (Num a, Ord a, Unbox a) => Int -> Vector a -> Maybe (Int, Vector a)
step :: Int -> Vector a -> Maybe (Int, Vector a)
step Int
width Vector a
v
| (a -> Bool) -> Vector a -> Bool
forall a. Unbox a => (a -> Bool) -> Vector a -> Bool
V.all (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0) Vector a
v = Maybe (Int, Vector a)
forall a. Maybe a
Nothing
| Bool
otherwise = Int -> Vector a -> Maybe (Int, Vector a)
forall b a.
(Unbox b, Ord b, Num b, Num a) =>
a -> Vector b -> Maybe (a, Vector b)
step' Int
0 (Vector a -> Maybe (Int, Vector a))
-> Vector a -> Maybe (Int, Vector a)
forall a b. (a -> b) -> a -> b
$ (a -> a) -> Vector a -> Vector a
forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
V.map (a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) Vector a
v
where
step' :: a -> Vector b -> Maybe (a, Vector b)
step' a
n Vector b
v'
| Just Int
i <- (b -> Bool) -> Vector b -> Maybe Int
forall a. Unbox a => (a -> Bool) -> Vector a -> Maybe Int
V.findIndex (b -> b -> Bool
forall a. Ord a => a -> a -> Bool
> b
9) Vector b
v' = a -> Vector b -> Maybe (a, Vector b)
step' (a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) (Vector b -> Maybe (a, Vector b))
-> Vector b -> Maybe (a, Vector b)
forall a b. (a -> b) -> a -> b
$ (b -> Bool -> b) -> Vector b -> [(Int, Bool)] -> Vector b
forall a b.
Unbox a =>
(a -> b -> a) -> Vector a -> [(Int, b)] -> Vector a
V.accum b -> Bool -> b
forall a. (Num a, Ord a) => a -> Bool -> a
f Vector b
v'
[ (Int
x' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y' Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width, Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x' Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y')
| let (Int
y, Int
x) = Int
i Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
width
, Int
x' <- (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int, Int) -> Int -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Int
0, Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) [Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1..Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1]
, Int
y' <- (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int, Int) -> Int -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Int
0, Vector b -> Int
forall a. Unbox a => Vector a -> Int
V.length Vector b
v' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) [Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1..Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1]
]
| Bool
otherwise = (a, Vector b) -> Maybe (a, Vector b)
forall a. a -> Maybe a
Just (a
n, (b -> b) -> Vector b -> Vector b
forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
V.map (b -> b -> b
forall a. Ord a => a -> a -> a
max b
0) Vector b
v')
f :: a -> Bool -> a
f a
_ Bool
True = -a
1
f a
a Bool
_ = if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 then a
a else a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
1
day11 :: Text -> Maybe (Int, Int)
day11 :: Text -> Maybe (Int, Int)
day11 Text
input = do
input' :: NonEmpty Text
input'@(Text
input0 :| [Text]
inputs) <- [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Text] -> Maybe (NonEmpty Text))
-> [Text] -> Maybe (NonEmpty Text)
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
input
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> NonEmpty Text -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit) NonEmpty Text
input'
let width :: Int
width = Text -> Int
T.length Text
input0
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
width) (Int -> Bool) -> (Text -> Int) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length) [Text]
inputs
let flashes :: [Int]
flashes = (Vector Int -> Maybe (Int, Vector Int)) -> Vector Int -> [Int]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (Int -> Vector Int -> Maybe (Int, Vector Int)
forall a.
(Num a, Ord a, Unbox a) =>
Int -> Vector a -> Maybe (Int, Vector a)
step Int
width) (Vector Int -> [Int]) -> Vector Int -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> Vector Int
forall a. Unbox a => [a] -> Vector a
V.fromList ([Int] -> Vector Int) -> [Int] -> Vector Int
forall a b. (a -> b) -> a -> b
$ Char -> Int
digitToInt (Char -> Int) -> [Char] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> [Char]) -> NonEmpty Text -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Text -> [Char]
T.unpack NonEmpty Text
input'
(Int, Int) -> Maybe (Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
100 [Int]
flashes, [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
flashes)