1
0
Fork 0

Fix Day1 to be more elegant

main
Bill Ewanick 2023-12-04 12:26:03 -05:00
parent caf3d3b43d
commit e316345265
1 changed files with 55 additions and 53 deletions

View File

@ -1,20 +1,20 @@
-- https://adventofcode.com/2023/day/1 -- https://adventofcode.com/2023/day/1
import Data.Bifunctor (bimap) import Data.Bifunctor (bimap, second)
import Data.Maybe (fromMaybe) import Data.Maybe (fromJust, fromMaybe, isJust)
import Data.Text (Text, pack, replace, unpack)
import Text.ParserCombinators.ReadP (ReadP, choice, many, readP_to_S, import Text.ParserCombinators.ReadP (ReadP, choice, many, readP_to_S,
string, (<++)) string, (<++))
main :: IO () main :: IO ()
main = do main = do
entries <- lines <$> readFile "src/advent_of_code/2023/input1" 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 entries
print ("Part 1: " <> show (solveP1 entries)) print ("Part 1: " <> show (solveP1 entries))
print ("Part 2: " <> show (solveP2 entries)) print ("Part 2: " <> show (solveP2 entries))
-- --
-- Part 1 -- Part 1
-- --
@ -36,26 +36,11 @@ solveP2 :: [String] -> Int
solveP2 = sum . map solveP2Line solveP2 = sum . map solveP2Line
solveP2Line :: String -> Int solveP2Line :: String -> Int
solveP2Line = sumPairS . bimap a b . doubleString solveP2Line = sumPairS . bimap head last . doubleString . map stringToNum . filter isNumP2 . tokenized tokensP2 . replaceAll overlaps
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
tokensP2 :: ReadP String tokensP2 :: ReadP String
tokensP2 = parseNumberWords <++ parseNumberChars <++ parseChars 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 -- Utility functions
-- --
@ -94,47 +79,64 @@ numberChars = map show [0..9]
numberWords :: [String] numberWords :: [String]
numberWords = ["zero", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine"] numberWords = ["zero", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine"]
overlapsSpec :: [(String, String)] parseChars :: ReadP String
overlapsSpec = parseChars = choice $ map (\c -> string [c]) letterChars
[ ("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
parseNumberChars :: ReadP String parseNumberChars :: ReadP String
parseNumberChars = choice $ map string numberChars parseNumberChars = choice $ map string numberChars
parseChars :: ReadP String parseNumberWords :: ReadP String
parseChars = choice $ map (\c -> string [c]) letterChars parseNumberWords = choice $ map string numberWords
tokenized :: ReadP a -> String -> [a] tokenized :: ReadP a -> String -> [a]
tokenized tokenSet = fst . last . readP_to_S (many tokenSet) 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 -- Examples
-- --