feat: solve day4 part 1

We look at each valid (having coordinates inside the grid) neighbor to
a cell including a paper roll and then see if the neighbor contains a
roll of paper or not. Finally we count the number of rolls, if it is
less than 4 we can pick it.

app/Day3.hs

@@ -39,7 +39,7 @@ part1 = sum . map (maximum . map combine . rights . foldl go [] . map digitToInt
     combine :: (Int, Int) -> Int
     combine (a, b) = a * 10 + b
 
-type CandidateN = [Int]
+type CandidateN = ([Int], Int)
 
 -- | Maintain one partial candidates for each length.
 --
@@ -49,18 +49,18 @@ type CandidateN = [Int]
 --
 -- Insight 2: We only ever need to store one candidate per length.
 part2 :: String -> Int
-part2 = sum . map (combine . (M.! 12) . foldl' checkPotential mempty . map digitToInt) . lines
+part2 = sum . map (snd . (M.! 12) . foldl' checkPotential mempty . map digitToInt) . lines
   where
     checkPotential :: Map Int CandidateN -> Int -> Map Int CandidateN
     checkPotential cs x =
       let partials = filter ((< 12) . length) $ M.elems cs
-          partials' = [x] : map (genPartial x) partials
+          partials' = ([x], x) : map (genPartial x) partials
        in foldl' insertMaxCandidate cs $ filter ((<= 12) . length) partials'
 
     -- generates new partials by appending x at candidate or after
     -- replacing a shedding smaller digits.
     genPartial :: Int -> CandidateN -> CandidateN
-    genPartial x candidate = candidate ++ [x]
+    genPartial x (ds, _) = let ds' = ds ++ [x] in (ds', combine ds')
 
     -- replaces a candidate with a better one with the same length
     insertMaxCandidate :: Map Int CandidateN -> CandidateN -> Map Int CandidateN
@@ -68,10 +68,10 @@ part2 = sum . map (combine . (M.! 12) . foldl' checkPotential mempty . map digit
 
     maxCandidate :: CandidateN -> CandidateN -> CandidateN
     maxCandidate a b
-      | combine a > combine b = a
+      | snd a > snd b = a
       | otherwise = b
 
-    combine :: CandidateN -> Int
+    combine :: [Int] -> Int
     combine xs = sum $ zipWith power [0 :: Int ..] (reverse xs)
 
     power :: Int -> Int -> Int

app/Day4.hs

@@ -0,0 +1,66 @@
+module Main where
+
+import Data.Map (Map)
+import qualified Data.Map as M
+import System.Environment (getArgs)
+
+main :: IO ()
+main = do
+  input <- readFile . head =<< getArgs
+  print $ part1 input
+  print $ part2 input
+
+part1 :: String -> Int
+part1 s = length $ filter (canPickRoll m) (M.keys m)
+  where
+    m = grid s
+
+grid :: String -> Map (Int, Int) Bool
+grid = M.fromList . concat . map (\(c, l) -> zipWith (\r ch -> ((r, c), ch == '@')) [0 ..] l) . zip [0 ..] . lines
+
+canPickRoll :: Map (Int, Int) Bool -> (Int, Int) -> Bool
+canPickRoll m p
+  | m M.! p = checkNeighbor m p
+  | otherwise = False
+  where
+    checkNeighbor :: Map (Int, Int) Bool -> (Int, Int) -> Bool
+    checkNeighbor m' = (< 4) . length . filter (m' M.!) . filter (validPos gridSize) . neighbors
+
+    neighbors :: (Int, Int) -> [(Int, Int)]
+    neighbors (r, c) =
+      [ (r + 1, c + 1),
+        (r + 1, c),
+        (r + 1, c - 1),
+        (r, c + 1),
+        (r, c - 1),
+        (r - 1, c + 1),
+        (r - 1, c),
+        (r - 1, c - 1)
+      ]
+
+    validPos :: (Int, Int) -> (Int, Int) -> Bool
+    validPos (nr, nc) (r, c) = r >= 0 && r < nr && c >= 0 && c < nc
+
+    gridSize :: (Int, Int)
+    gridSize = duplicate . round . sqrt @Double . fromIntegral . M.size $ m
+
+    duplicate :: a -> (a, a)
+    duplicate a = (a, a)
+
+part2 :: String -> Int
+part2 = error "Not implemented"
+
+testInput :: String
+testInput =
+  unlines
+    [ "..@@.@@@@.",
+      "@@@.@.@.@@",
+      "@@@@@.@.@@",
+      "@.@@@@..@.",
+      "@@.@@@@.@@",
+      ".@@@@@@@.@",
+      ".@.@.@.@@@",
+      "@.@@@.@@@@",
+      ".@@@@@@@@.",
+      "@.@.@@@.@."
+    ]