urghhh
This commit is contained in:
parent
dd2bcc94a5
commit
2d91ec1831
107
day4.hs
Normal file
107
day4.hs
Normal file
@ -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
|
Loading…
Reference in New Issue
Block a user