~rootmos/AoC

00e6d7742c32d2cee3dbcef871b1a8ab4f6d845f — Gustav Behm 1 year, 3 months ago b6909c6
Add solution to AoC 2022 #18b
2 files changed, 21 insertions(+), 4 deletions(-)

M 2022/18.hs
M templates/template.hs
M 2022/18.hs => 2022/18.hs +20 -4
@@ 9,6 9,7 @@ import Qulude

--import Data.Array ( (!) )
import qualified Data.Array as Array
import qualified Data.Array.ST as STArray
import qualified Data.Either as Either
import qualified Data.List as List
--import Data.Array ( (!) )


@@ 40,12 41,27 @@ partA (c:cs) = fst $ foldl' f (6, Set.singleton c) cs
  where f (n, cs) c = let n' = count $ fmap (flip Set.member cs) $ neighbors c in
                      (n-n'+(6-n'), Set.insert c cs)

--partB :: Parse -> Parse
--partB = id
partB :: Parse -> Int
partB cs = partA $ runST $ do
  colors <- STArray.newArray bs False
  color [fst bs] colors
  fmap fst . filter (not . snd) <$> STArray.getAssocs colors
    where cs' = Set.fromList cs
          bs = g $ foldl' f ((0,0,0),(0,0,0)) cs
          f ((x0,y0,z0),(x1,y1,z1)) (x,y,z) =
            ((min x x0,min y y0,min z z0),(max x x1,max y y1,max z z1))
          g ((x0,y0,z0),(x1,y1,z1)) = ((x0-1,y0-1,z0-1),(x1+1,y1+1,z1+1))
          color :: [Cube] -> STUArray s Cube Bool -> ST s ()
          color [] _ = return ()
          color (u:acc) colors = do
            let ns = filter (not . flip Set.member cs') $ filter (STArray.inRange bs) $ neighbors u
            ns' <- filterM (fmap not . STArray.readArray colors) ns
            STArray.writeArray colors u True
            color (ns' `combine` acc) colors

main :: IO ()
main = with parser $ do
  run' "18.example" "a example" partA 64
  run' "18.input" "a input" partA 4300
  --run "18.example" "b example" partB
  --run "18.input" "b input" partB
  run' "18.example" "b example" partB 58
  run' "18.input" "b input" partB 2490

M templates/template.hs => templates/template.hs +1 -0
@@ 9,6 9,7 @@ import Qulude

--import Data.Array ( (!) )
import qualified Data.Array as Array
import qualified Data.Array.ST as STArray
import qualified Data.Either as Either
import qualified Data.List as List
--import Data.Array ( (!) )