|
|
@@ -0,0 +1,107 @@ |
|
|
|
-- a haiku: |
|
|
|
-- this is some bad code |
|
|
|
-- but what more can you expect |
|
|
|
-- from a bad problem? |
|
|
|
|
|
|
|
import Data.Char (isDigit, isHexDigit) |
|
|
|
import Data.List (sort, nub) |
|
|
|
|
|
|
|
main :: IO () |
|
|
|
main = do |
|
|
|
raw <- readFile "day4.txt" |
|
|
|
let ls = parse $ lines raw |
|
|
|
ansA = length $ filter (== True) $ map solveA ls |
|
|
|
ansB = length $ filter (== True) $ map solveB ls |
|
|
|
in do |
|
|
|
putStrLn $ "day3a: " ++ (show ansA) |
|
|
|
putStrLn $ "day3b: " ++ (show ansB) |
|
|
|
|
|
|
|
rtags :: [String] |
|
|
|
rtags = ["byr", "iyr", "eyr", "hgt", "hcl", "ecl", "pid"] |
|
|
|
|
|
|
|
extractTag :: String -> String |
|
|
|
extractTag [] = error "empty tag" |
|
|
|
extractTag s = takeWhile (/= ':') s |
|
|
|
|
|
|
|
extractValue :: String -> String |
|
|
|
extractValue [] = error "empty value" |
|
|
|
extractValue s = drop 1 $ dropWhile (/= ':') s |
|
|
|
|
|
|
|
applyAll :: [a] -> [(a -> b)] -> [b] |
|
|
|
applyAll [] [] = [] |
|
|
|
applyAll (a:as) (f:fs) = |
|
|
|
if length as /= length fs |
|
|
|
then error "applyAll: lists must be same length" |
|
|
|
else (f a) : (applyAll as fs) |
|
|
|
|
|
|
|
solveA :: [String] -> Bool |
|
|
|
solveA [] = False |
|
|
|
solveA s = foldr (&&) True $ map (`elem` tags) rtags |
|
|
|
where |
|
|
|
tags = map extractTag s |
|
|
|
|
|
|
|
solveB :: [String] -> Bool |
|
|
|
solveB [] = False |
|
|
|
solveB s = solveA s && |
|
|
|
(foldr (&&) True $ applyAll ls |
|
|
|
[ byrValid |
|
|
|
, eclValid |
|
|
|
, eyrValid |
|
|
|
, hclValid |
|
|
|
, hgtValid |
|
|
|
, iyrValid |
|
|
|
, pidValid |
|
|
|
]) |
|
|
|
where |
|
|
|
ls = (sort . nub) $ filter (\x -> elem (extractTag x) rtags) s |
|
|
|
|
|
|
|
yearValid :: Int -> Int -> String -> Bool |
|
|
|
yearValid l u s' = (length s) == 4 |
|
|
|
&& (read s) >= l |
|
|
|
&& (read s) <= u |
|
|
|
where |
|
|
|
s = drop 1 $ dropWhile (/= ':') s' |
|
|
|
|
|
|
|
byrValid :: String -> Bool |
|
|
|
byrValid = yearValid 1920 2002 |
|
|
|
|
|
|
|
iyrValid :: String -> Bool |
|
|
|
iyrValid = yearValid 2010 2020 |
|
|
|
|
|
|
|
eyrValid :: String -> Bool |
|
|
|
eyrValid = yearValid 2020 2030 |
|
|
|
|
|
|
|
eclValid :: String -> Bool |
|
|
|
eclValid s' = s `elem` ["amb","blu","brn","gry","grn","hzl","oth"] |
|
|
|
where |
|
|
|
s = drop 1 $ dropWhile (/= ':') s' |
|
|
|
|
|
|
|
pidValid :: String -> Bool |
|
|
|
pidValid s' = (length s) == 9 && all isDigit s |
|
|
|
where |
|
|
|
s = drop 1 $ dropWhile (/= ':') s' |
|
|
|
|
|
|
|
hclValid :: String -> Bool |
|
|
|
hclValid s' = h == '#' && all isHexDigit s |
|
|
|
where |
|
|
|
(h:s) = drop 1 $ dropWhile (/= ':') s' |
|
|
|
|
|
|
|
hgtValid :: String -> Bool |
|
|
|
hgtValid s' = |
|
|
|
case unit of |
|
|
|
"cm" -> val >= 150 && val <= 193 |
|
|
|
"in" -> val >= 59 && val <= 76 |
|
|
|
_ -> False |
|
|
|
where |
|
|
|
s = drop 1 $ dropWhile (/= ':') s' |
|
|
|
(val,unit) = head $ (reads s :: [(Int,String)]) |
|
|
|
|
|
|
|
parse :: [String] -> [[String]] |
|
|
|
parse [] = [] |
|
|
|
parse s = parse' s [] [] |
|
|
|
|
|
|
|
parse' :: [String] -> [String] -> [[String]] -> [[String]] |
|
|
|
parse' [] as bs = bs ++ [as] |
|
|
|
parse' (s:ss) as bs |
|
|
|
| s == "" = parse' ss [] $ bs ++ [as] |
|
|
|
| otherwise = parse' ss (as ++ (words s)) bs |