From f36d3739a01216c2c0deb62d1a014812a016ca56 Mon Sep 17 00:00:00 2001 From: Javran Cheng Date: Sat, 6 Jan 2024 22:26:13 -0800 Subject: [PATCH] day 3 cleanup --- src/Javran/AdventOfCode/Y2023/Day3.hs | 74 +++++++++++++-------------- 1 file changed, 37 insertions(+), 37 deletions(-) diff --git a/src/Javran/AdventOfCode/Y2023/Day3.hs b/src/Javran/AdventOfCode/Y2023/Day3.hs index 288d8129..bfdb2e7d 100644 --- a/src/Javran/AdventOfCode/Y2023/Day3.hs +++ b/src/Javran/AdventOfCode/Y2023/Day3.hs @@ -1,33 +1,11 @@ -{-# LANGUAGE PatternGuards #-} -{-# LANGUAGE ViewPatterns #-} -{-# OPTIONS_GHC -Wno-deprecations #-} -{-# OPTIONS_GHC -Wno-typed-holes #-} -{-# OPTIONS_GHC -Wno-unused-imports #-} -{-# OPTIONS_GHC -fdefer-typed-holes #-} - module Javran.AdventOfCode.Y2023.Day3 () where -{- HLINT ignore -} - -import Control.Applicative import Control.Monad import Data.Char -import Data.Function -import Data.Function.Memoize (memoFix) -import qualified Data.IntMap.Strict as IM -import qualified Data.IntSet as IS -import Data.List -import Data.List.Split hiding (sepBy) import qualified Data.Map.Strict as M import Data.Monoid hiding (First, Last) -import Data.Semigroup -import qualified Data.Set as S -import qualified Data.Text as T -import qualified Data.Vector as V -import GHC.Generics (Generic) import Javran.AdventOfCode.GridSystem.RowThenCol.Uldr import Javran.AdventOfCode.Prelude -import Text.ParserCombinators.ReadP hiding (count, get, many) data Day3 deriving (Generic) @@ -58,6 +36,11 @@ parseSchematic inp = (M.fromList syms, nums) partitionEithers $ fmap (\(coord, e) -> bimap (coord,) (coord,) e) tokens +{- + Tests whether a number is adjacent to a coord (which is a symbol). + + I feel it's easier that we draw this "rectangle" and see if symbol coordinate is inside. + -} isAdjacent :: (Coord, ANum) -> Coord -> Bool isAdjacent ((nr, nc), (_, nl)) (sr, sc) = nr - 1 <= sr && sr <= nr + 1 && nc - 1 <= sc && sc <= nc + nl @@ -65,25 +48,42 @@ isAdjacent ((nr, nc), (_, nl)) (sr, sc) = instance Solution Day3 where solutionSolved _ = True solutionRun _ SolutionContext {getInputS, answerShow} = do - xs <- lines <$> getInputS - let (syms, nums) = parseSchematic xs + (syms, nums) <- parseSchematic . lines <$> getInputS + answerShow + . getSum + . foldMap + ( \n@(_, (v, _)) -> + {- + Note that we can further squeeze some performance by only feeding + the relevant 3 rows (with middle row being where the number is located) + of symbols instead of all of them and skip row range checks on + `isAdjacent`. + However given the scale of input data I don't think it worth the effort. + -} + if any (isAdjacent n) $ M.keys syms then Sum v else 0 + ) + $ nums do - let rs = filter (\n -> any (isAdjacent n) $ M.keys syms) nums - answerShow $ sum $ fmap (fst . snd) rs - let mayGearCoords :: [Coord] + let + -- Coordinates of could-be gears + mayGearCoords :: [Coord] mayGearCoords = M.keys $ M.filter (== '*') syms - adjacentCounts :: M.Map Coord [Int] + {- + Builds up a map from could-be gear coordinates to values of numbers + that are adjacent to them + -} adjacentCounts = M.fromListWith (<>) do n@(_, (v, _)) <- nums g <- mayGearCoords guard $ isAdjacent n g pure (g, [v]) - answerShow - . getSum - . foldMap - ( \case - [a, b] -> Sum $ a * b - _ -> 0 - ) - $ M.elems - adjacentCounts + answerShow + . getSum + . foldMap + ( \case + [a, b] -> + -- only counts when the list contains exactly 2 elements. + Sum $ a * b + _ -> 0 + ) + $ adjacentCounts