diff --git a/src/advent_of_code/2023/1.hs b/src/advent_of_code/2023/1.hs index f330ab4..2f77af4 100644 --- a/src/advent_of_code/2023/1.hs +++ b/src/advent_of_code/2023/1.hs @@ -1,20 +1,20 @@ -- https://adventofcode.com/2023/day/1 -import Data.Bifunctor (bimap) -import Data.Maybe (fromMaybe) +import Data.Bifunctor (bimap, second) +import Data.Maybe (fromJust, fromMaybe, isJust) +import Data.Text (Text, pack, replace, unpack) import Text.ParserCombinators.ReadP (ReadP, choice, many, readP_to_S, string, (<++)) main :: IO () main = do entries <- lines <$> readFile "src/advent_of_code/2023/input1" - print "Advent of Code 2022 - Day 4" + print "Advent of Code 2023 - Day 1" -- print entries print ("Part 1: " <> show (solveP1 entries)) print ("Part 2: " <> show (solveP2 entries)) - -- -- Part 1 -- @@ -36,26 +36,11 @@ solveP2 :: [String] -> Int solveP2 = sum . map solveP2Line solveP2Line :: String -> Int -solveP2Line = sumPairS . bimap a b . doubleString - where - a = head . condense . fromLeft - b = last . condense . fromRight - -- Need to parse from both sides - -- "oneight" should return 18, not 11 - - condense = map stringToNum . filter isNumP2 - fromLeft = tokenized tokensP2 - fromRight = map reverse . reverse . tokenized tokensP2' . reverse +solveP2Line = sumPairS . bimap head last . doubleString . map stringToNum . filter isNumP2 . tokenized tokensP2 . replaceAll overlaps tokensP2 :: ReadP String tokensP2 = parseNumberWords <++ parseNumberChars <++ parseChars -tokensP2' :: ReadP String -tokensP2' = parseNumberWords' <++ parseNumberChars <++ parseChars - -solveP2LineBad :: String -> Int -solveP2LineBad = sumPairS . bimap head last . doubleString . map stringToNum . filter isNumP2 . tokenized tokensP2 - -- -- Utility functions -- @@ -94,47 +79,64 @@ numberChars = map show [0..9] numberWords :: [String] numberWords = ["zero", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine"] -overlapsSpec :: [(String, String)] -overlapsSpec = - [ ("zero" , "one" ) - , ("one" , "eight") - , ("two" , "one" ) - , ("three", "eight") - , ("five" , "eight") - , ("seven", "nine" ) - , ("eight", "two" ) - , ("eight", "three") - , ("nine" , "eight") - ] - -overlapsDerived :: [(String, [String])] -overlapsDerived = zip numberWords $ map findOverlaps numberWords - -findOverlaps :: String -> [String] -findOverlaps str = filter (\s -> last str == head s) numberWords - -combineOverlaps :: (String, [String]) -> [String] -combineOverlaps (numStr, [] ) = [] -combineOverlaps (numStr, over:laps) = (numStr ++ tail over) : combineOverlaps (numStr, laps) - -overlaps :: [String] -overlaps = filter (/= "") $ concatMap combineOverlaps overlapsDerived - -parseNumberWords :: ReadP String -parseNumberWords = choice $ map string numberWords - -parseNumberWords' :: ReadP String -parseNumberWords' = choice $ map (string . reverse) numberWords +parseChars :: ReadP String +parseChars = choice $ map (\c -> string [c]) letterChars parseNumberChars :: ReadP String parseNumberChars = choice $ map string numberChars -parseChars :: ReadP String -parseChars = choice $ map (\c -> string [c]) letterChars +parseNumberWords :: ReadP String +parseNumberWords = choice $ map string numberWords tokenized :: ReadP a -> String -> [a] tokenized tokenSet = fst . last . readP_to_S (many tokenSet) +-- +-- Detecting overlaps +-- - Instead of reversing to tokenize from the right, I'm using the numberWords list to create a set of possible string overlaps +-- - later I'll detect these and replace them, to be able to parse all strings from left to right +-- + +overlaps :: [(String, String)] +overlaps = concatMap combineOverlaps overlapsDerived + +-- Not used, but the full list written manually +overlapsSpec :: [((String, String), String)] +overlapsSpec = + [ (("zero" , "one" ), "01") + , (("one" , "eight"), "18") + , (("two" , "one" ), "21") + , (("three", "eight"), "38") + , (("five" , "eight"), "58") + , (("seven", "nine" ), "79") + , (("eight", "two" ), "82") + , (("eight", "three"), "83") + , (("nine" , "eight"), "98") + ] + +overlapsDerived :: [(String, [String])] +overlapsDerived = map (second fromJust) . filter (isJust . snd) . zip numberWords $ map findOverlaps numberWords + where + findOverlaps :: String -> Maybe [String] + findOverlaps str = if null overlaps then Nothing else Just overlaps + where + overlaps = filter (\s -> last str == head s) numberWords + +combineOverlaps :: (String, [String]) -> [(String, String)] +combineOverlaps (numStr, [] ) = [] +combineOverlaps (numStr, over:laps) = (numStr ++ tail over, stringToNum numStr ++ stringToNum over) : combineOverlaps (numStr, laps) + +-- String replace using Text lol +replace' :: String -> String -> String -> String +replace' needle replacement haystack = unpack $ replace needle' replacement' haystack' + where + needle' = pack needle + replacement' = pack replacement + haystack' = pack haystack + +replaceAll :: [(String, String)] -> String -> String +replaceAll overlaps str = foldl (\haystack (needle, replacement) -> replace' needle replacement haystack) str overlaps + -- -- Examples --