1 -- Writeup at https://work.njae.me.uk/2021/12/23/advent-of-code-2021-day-20/
3 import Control.Monad.State.Strict
4 import Control.Monad.Reader
5 -- import Control.Monad.Writer
6 import Control.Monad.RWS.Strict
11 import qualified Data.Set as S
12 import Linear (V2(..), (^+^))
14 type Pixel = V2 Int -- row, column
18 , distantPixel :: Bool
19 , explicitRegion :: (Pixel, Pixel)
22 type Enhancement = [Bool]
24 type ImageEnhancer = RWS Enhancement [Int] Image
28 do text <- readFile "data/advent20.txt"
29 let (enhancement, image) = parse text
30 print $ part1 enhancement image
31 print $ part2 enhancement image
33 -- part1 enhancement image = s
34 -- where (s, image', _) = runRWS (enhanceImage 2) enhancement image
36 part1 enhancement image = fst $ evalRWS (enhanceImage 2) enhancement image
38 part2 enhancement image = fst $ evalRWS (enhanceImage 50) enhancement image
40 enhanceImage :: Int -> ImageEnhancer Int
41 enhanceImage 0 = do image <- get
42 return $ S.size $ grid image
43 enhanceImage n = do newImage
47 newImage :: ImageEnhancer ()
49 do region <- gets explicitRegion
50 let region' = expandRegion region
51 let heres = range region'
52 newPixels <- mapM newPixel heres
53 let grid' = S.fromList $ catMaybes newPixels
54 distant <- gets distantPixel
56 let distant' = if distant then (last enhancement) else (head enhancement)
57 put $ Image {grid = grid', distantPixel = distant', explicitRegion = region'}
59 showImage :: Image -> String
61 unlines $ [ [showPixel (V2 r c) | c <- [minC..maxC] ] | r <- [minR..maxR]]
62 where (V2 minR minC, V2 maxR maxC) = explicitRegion image
64 showPixel here = if here `S.member` g then '█' else ' '
66 newPixel :: Pixel -> ImageEnhancer (Maybe Pixel)
68 do stencil <- findStencil here
69 let i = intify stencil
71 return $ if enh!!i then Just here else Nothing
73 findStencil :: Pixel -> ImageEnhancer [Bool]
75 do let nbrs = map (here ^+^) neighbours
77 d <- gets distantPixel
78 r <- gets explicitRegion
79 return $ map (findContents g d r) nbrs
80 -- mapM findContents nbrs
82 findContents :: S.Set Pixel -> Bool -> (Pixel, Pixel) -> Pixel -> Bool
83 findContents grid distant region here
84 | inRange region here = here `S.member` grid
87 -- more consitent but much slower
88 -- findContents :: Pixel -> ImageEnhancer Bool
89 -- findContents here =
91 -- distant <- gets distantPixel
92 -- region <- gets explicitRegion
93 -- return $ if inRange region here
94 -- then (here `S.member` g)
98 neighbours = [V2 r c | r <- [-1, 0, 1], c <- [-1, 0, 1]]
100 expandRegion :: (Pixel, Pixel) -> (Pixel, Pixel)
101 expandRegion ((V2 r0 c0), (V2 r1 c1)) = (V2 (r0 - 1) (c0 - 1), V2 (r1 + 1) (c1 + 1))
103 parse :: String -> (Enhancement, Image)
104 parse text = (enhancement, image)
105 where ls = lines text
106 enhancement = [ c == '#' | c <- head ls]
107 image = mkImage $ drop 2 ls
110 mkImage :: [String] -> Image
111 mkImage rows = Image { grid = grid, distantPixel = False
112 , explicitRegion = ((V2 0 0), (V2 maxRow maxCol))
114 where maxRow = length rows - 1
115 maxCol = (length $ head rows) - 1
116 grid = S.fromList [V2 r c | r <- [0..maxRow], c <- [0..maxCol], (rows!!r)!!c == '#']
118 intify :: [Bool] -> Int
119 intify pixels = foldl' addBit 0 pixels
120 where addBit w b = (w * 2) + (if b then 1 else 0)