patrickaldis/garnet
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Solve day 4 part 2

Browse Source
This commit is contained in:
George Thomas 2025-12-04 20:00:53 +00:00
parent 649f06821b
commit 0508947a65
2 changed files with 44 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
haskell/Puzzles/Day4.hs
View File

@ -18,16 +18,29 @@ puzzle =
{ number = 4 { number = 4
, parser = flip sepEndBy newline $ some $ asum $ enumerate <&> \t -> char (inToChar t) $> t , parser = flip sepEndBy newline $ some $ asum $ enumerate <&> \t -> char (inToChar t) $> t
, parts = , parts =
[ \input -> [ T.show
let inputWithCoords = zipWith (map . first . V2) [0 ..] $ map (zip [0 ..]) input . fst
inputSeq = Seq.fromList $ map Seq.fromList input . findAccessible
in T.show . addCoords
. length , T.show
. concatMap (filter (== OutAccessible)) . sum
$ inputWithCoords <<&>> \(v, t) -> case t of . unfoldr ((\r -> guard (fst r /= 0) $> r) . (removeAccessibleRolls <<<<$>>>>) . findAccessible)
. addCoords
]
}
addCoords :: (Num a, Enum a) => [[c]] -> [[(V2 a, c)]]
addCoords = zipWith (map . first . V2) [0 ..] . map (zip [0 ..])
findAccessible :: [[(V2 Int, InTile)]] -> (Int, [[(V2 Int, OutTile)]])
findAccessible inGrid =
let
gridSeq = Seq.fromList $ map Seq.fromList inGrid
outGrid =
inGrid <<&>> \(v, t) -> (v,) case t of
InEmpty -> OutEmpty InEmpty -> OutEmpty
InRoll -> InRoll ->
if length (filter (== Just InRoll) neighbours) < 4 if length (filter ((== Just InRoll) . fmap snd) neighbours) < 4
then OutAccessible then OutAccessible
else OutRoll else OutRoll
where where
@ -36,9 +49,10 @@ puzzle =
y <- [-1 .. 1] y <- [-1 .. 1]
guard $ not (x == 0 && y == 0) guard $ not (x == 0 && y == 0)
let V2 x' y' = v + V2 x y let V2 x' y' = v + V2 x y
pure $ Seq.lookup x' inputSeq >>= Seq.lookup y' pure $ Seq.lookup x' gridSeq >>= Seq.lookup y'
] accessibleRolls = length $ concatMap (filter (== OutAccessible) . map snd) outGrid
} in
(accessibleRolls, outGrid)
data InTile data InTile
= InEmpty = InEmpty
@ -64,7 +78,17 @@ outToChar = \case
drawGridOut :: [[OutTile]] -> String drawGridOut :: [[OutTile]] -> String
drawGridOut = unlines . map (map outToChar) drawGridOut = unlines . map (map outToChar)
removeAccessibleRolls :: OutTile -> InTile
removeAccessibleRolls = \case
OutEmpty -> InEmpty
OutRoll -> InRoll
OutAccessible -> InEmpty
(<<$>>) :: (Functor f1, Functor f2) => (a -> b) -> f1 (f2 a) -> f1 (f2 b) (<<$>>) :: (Functor f1, Functor f2) => (a -> b) -> f1 (f2 a) -> f1 (f2 b)
(<<$>>) = fmap . fmap (<<$>>) = fmap . fmap
(<<&>>) :: (Functor f1, Functor f2) => f1 (f2 a) -> (a -> b) -> f1 (f2 b) (<<&>>) :: (Functor f1, Functor f2) => f1 (f2 a) -> (a -> b) -> f1 (f2 b)
(<<&>>) = flip (<<$>>) (<<&>>) = flip (<<$>>)
(<<<$>>>) :: (Functor f, Functor f1, Functor f2) => (a -> b) -> f (f1 (f2 a)) -> f (f1 (f2 b))
(<<<$>>>) = fmap . (<<$>>)
(<<<<$>>>>) :: (Functor f1, Functor f2, Functor f3, Functor f4) => (a -> b) -> f1 (f2 (f3 (f4 a))) -> f1 (f2 (f3 (f4 b)))
(<<<<$>>>>) = fmap . (<<<$>>>)

1
outputs/real/4/2 Normal file
View File

@ -0,0 +1 @@
8765