{-# LANGUAGE OverloadedStrings, ViewPatterns #-}
module Day20 (day20a, day20b) where
import Control.Monad ((>=>))
import Data.Bits ((.&.))
import Data.Char (ord)
import Data.List (tails)
import Data.Text (Text)
import qualified Data.Text as T (compareLength, concat, cons, count, foldl', index, length, lines, pack, null, replicate, singleton, snoc, tails, take)
day20 :: Text -> Maybe [Maybe Int]
day20 :: Text -> Maybe [Maybe Int]
day20 (Text -> [Text]
T.lines -> Text
alg:Text
blank:[Text]
image0)
| Text -> Int
T.length Text
alg Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
512 Bool -> Bool -> Bool
&& Text -> Bool
T.null Text
blank
= [Maybe Int] -> Maybe [Maybe Int]
forall a. a -> Maybe a
Just ([Maybe Int] -> Maybe [Maybe Int])
-> [Maybe Int] -> Maybe [Maybe Int]
forall a b. (a -> b) -> a -> b
$ ([Text], Char) -> Maybe Int
forall (t :: * -> *).
(Foldable t, Functor t) =>
(t Text, Char) -> Maybe Int
count (([Text], Char) -> Maybe Int) -> [([Text], Char)] -> [Maybe Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Text], Char) -> ([Text], Char))
-> ([Text], Char) -> [([Text], Char)]
forall a. (a -> a) -> a -> [a]
iterate ([Text], Char) -> ([Text], Char)
enhance ([Text]
image0, Char
'.')
where
get :: Text -> Char
get Text
s = Text -> Int -> Char
T.index Text
alg (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ (Int -> Char -> Int) -> Int -> Text -> Int
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' (\Int
x Char
y -> Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
y Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
1) Int
0 Text
s
enhance :: ([Text], Char) -> ([Text], Char)
enhance ([Text]
image, Char
fill) = ([Text]
image', Text -> Char
get (Text -> Char) -> Text -> Char
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate Int
9 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
fill) where
line4 :: Text
line4 = Int -> Text -> Text
T.replicate (Text -> Int
T.length (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. [a] -> a
head [Text]
image) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
fill
win3 :: Text -> [Text]
win3 = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
T.take Int
3) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((Ordering -> Ordering -> Bool
forall a. Ord a => a -> a -> Bool
> Ordering
LT) (Ordering -> Bool) -> (Text -> Ordering) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Int -> Ordering) -> Int -> Text -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Int -> Ordering
T.compareLength Int
3) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.tails (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Char -> Text -> Text
T.cons Char
fill (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text -> Text
T.cons Char
fill (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Char -> Text) -> Char -> Text -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Char -> Text
T.snoc Char
fill (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Char -> Text) -> Char -> Text -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Char -> Text
T.snoc Char
fill
image' :: [Text]
image' = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
image then [Text]
image else
[ String -> Text
T.pack [Text -> Char
get (Text -> Char) -> Text -> Char
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
a, Text
b, Text
c] | (Text
a, Text
b, Text
c) <- [Text] -> [Text] -> [Text] -> [(Text, Text, Text)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 (Text -> [Text]
win3 Text
line1) (Text -> [Text]
win3 Text
line2) (Text -> [Text]
win3 Text
line3)]
| Text
line1:Text
line2:Text
line3:[Text]
_ <- [Text] -> [[Text]]
forall a. [a] -> [[a]]
tails ([Text] -> [[Text]]) -> [Text] -> [[Text]]
forall a b. (a -> b) -> a -> b
$ Text
line4 Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
line4 Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
image [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
line4, Text
line4]
]
count :: (t Text, Char) -> Maybe Int
count (t Text
image, Char
'.') = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ t Int -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (t Int -> Int) -> t Int -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Int
T.count Text
"#" (Text -> Int) -> t Text -> t Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t Text
image
count (t Text, Char)
_ = Maybe Int
forall a. Maybe a
Nothing
day20 Text
_ = Maybe [Maybe Int]
forall a. Maybe a
Nothing
day20a :: Text -> Maybe Int
day20a :: Text -> Maybe Int
day20a = Text -> Maybe [Maybe Int]
day20 (Text -> Maybe [Maybe Int])
-> ([Maybe Int] -> Maybe Int) -> Text -> Maybe Int
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ([Maybe Int] -> Int -> Maybe Int
forall a. [a] -> Int -> a
!! Int
2)
day20b :: Text -> Maybe Int
day20b :: Text -> Maybe Int
day20b = Text -> Maybe [Maybe Int]
day20 (Text -> Maybe [Maybe Int])
-> ([Maybe Int] -> Maybe Int) -> Text -> Maybe Int
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ([Maybe Int] -> Int -> Maybe Int
forall a. [a] -> Int -> a
!! Int
50)