Done day 20

[advent-of-code-21.git] / advent20 / Main.hs

diff --git a/advent20/Main.hs b/advent20/Main.hs
new file mode 100644 (file)
index 0000000..fbc4fb6
--- /dev/null
+++ b/advent20/Main.hs
@@ -0,0 +1,115 @@
+-- Writeup at https://work.njae.me.uk/2021/12/18/advent-of-code-2021-day-16/
+
+
+import Control.Monad.State.Strict
+import Control.Monad.Reader
+-- import Control.Monad.Writer
+import Control.Monad.RWS.Strict
+import Data.List
+import Data.Ix
+import Data.Maybe
+
+import qualified Data.Set as S
+import Linear (V2(..), (^+^))
+
+type Pixel = V2 Int -- row, column
+
+data Image = Image 
+  { grid :: S.Set Pixel
+  , distantPixel :: Bool
+  , explicitRegion :: (Pixel, Pixel)
+  } deriving (Eq, Show)
+
+type Enhancement = [Bool]
+
+type ImageEnhancer = RWS Enhancement [Int] Image
+
+main :: IO ()
+main = 
+  do  text <- readFile "data/advent20.txt"
+      let (enhancement, image) = parse text
+      print $ part1 enhancement image
+      print $ part2 enhancement image
+
+-- part1 enhancement image = s
+--   where (s, image', _) = runRWS (enhanceImage 2) enhancement image
+
+part1 enhancement image = fst $ evalRWS (enhanceImage 2) enhancement image
+
+part2 enhancement image = fst $ evalRWS (enhanceImage 50) enhancement image
+
+enhanceImage :: Int -> ImageEnhancer Int
+enhanceImage 0 = do image <- get
+                    return $ S.size $ grid image
+enhanceImage n = do newImage
+                    enhanceImage (n - 1)
+
+newImage :: ImageEnhancer ()
+newImage =
+  do  image <- get
+      let region = explicitRegion image
+      let region' = expandRegion region
+      let heres = range region'
+      let distant = distantPixel image
+      newPixelStates <- mapM newPixel heres
+      let grid' = S.fromList $ catMaybes newPixelStates
+      enhancement <- ask
+      let distant' = if distant then (last enhancement) else (head enhancement)
+      put $ Image {grid = grid', distantPixel = distant', explicitRegion = region'}
+
+
+showImage :: Image -> String
+showImage image = 
+  unlines $ [ [showPixel (V2 r c) | c <- [minC..maxC] ] | r <- [minR..maxR]]
+  where (V2 minR minC, V2 maxR maxC) = explicitRegion image
+        g = grid image
+        showPixel here = if here `S.member` g then '█' else ' '
+
+newPixel :: Pixel -> ImageEnhancer (Maybe Pixel)
+newPixel here =
+  do  stencil <- findStencil here
+      let i = intify stencil
+      enh <- ask
+      return $ if enh!!i then Just here else Nothing
+
+findStencil :: Pixel -> ImageEnhancer [Bool]
+findStencil here = 
+  do  let nbrs = map (here ^+^) neighbours
+      g <- gets grid
+      d <- gets distantPixel
+      r <- gets explicitRegion
+      return $ map (findContents g d r) nbrs
+
+findContents :: S.Set Pixel -> Bool -> (Pixel, Pixel) -> Pixel -> Bool
+findContents grid distant region here 
+  | inRange region here = here `S.member` grid
+  | otherwise           = distant
+
+
+neighbours :: [Pixel]
+neighbours = [V2 r c | r <- [-1, 0, 1], c <- [-1, 0, 1]]
+
+expandRegion :: (Pixel, Pixel) -> (Pixel, Pixel)
+expandRegion ((V2 r0 c0), (V2 r1 c1)) = (V2 (r0 - 1) (c0 - 1), V2 (r1 + 1) (c1 + 1))
+
+parse text = (enhancement, image)
+  where ls = lines text
+        enhancement = [ c == '#' | c <- head ls]
+        image = mkImage $ drop 2 ls
+
+
+mkImage :: [String] -> Image
+mkImage rows = Image { grid = grid, distantPixel = False
+                     , explicitRegion = ((V2 0 0), (V2 maxRow maxCol))
+                     }
+  where maxRow = length rows - 1
+        maxCol = (length $ head rows) - 1
+        grid = S.fromList [V2 r c | r <- [0..maxRow], c <- [0..maxCol], (rows!!r)!!c == '#']
+
+
+intify pixels = foldl' addBit 0 pixels
+  where addBit w b = (w * 2) + (if b then 1 else 0)
+
+-- wordify :: BS.BitString -> Integer
+-- wordify bs = foldl' addBit 0 $ BS.to01List bs
+--   where addBit w b = (w * 2) + (fromIntegral b)