diff options
Diffstat (limited to 'execs')
-rw-r--r-- | execs/Day04.hs | 93 |
1 files changed, 39 insertions, 54 deletions
diff --git a/execs/Day04.hs b/execs/Day04.hs index 04aacbb..565415f 100644 --- a/execs/Day04.hs +++ b/execs/Day04.hs | |||
@@ -1,14 +1,13 @@ | |||
1 | module Main where | 1 | module Main where |
2 | 2 | ||
3 | import Text.ParserCombinators.Parsec | 3 | import Text.ParserCombinators.Parsec |
4 | import Text.Parsec.Char | 4 | import Data.Map.Strict (Map, (!)) |
5 | import Data.Either | 5 | import qualified Data.Map.Strict as Map |
6 | import Data.Maybe | 6 | import Data.Char (isDigit, isHexDigit) |
7 | import Control.Monad | ||
8 | import Data.List (sortOn) | ||
9 | 7 | ||
10 | right (Right a) = a | 8 | right (Right a) = a |
11 | fields = [ "byr" , "iyr" , "eyr" , "hgt" , "hcl" , "ecl" , "pid" ] | 9 | requiredFields = [ "byr" , "iyr" , "eyr" , "hgt" , "hcl" , "ecl" , "pid" ] |
10 | eyeColors = ["amb", "blu", "brn", "gry", "grn", "hzl", "oth"] | ||
12 | 11 | ||
13 | block = cell `sepBy` oneOf " \n" | 12 | block = cell `sepBy` oneOf " \n" |
14 | cell = do | 13 | cell = do |
@@ -17,55 +16,41 @@ cell = do | |||
17 | rest <- many (alphaNum <|> char '#') | 16 | rest <- many (alphaNum <|> char '#') |
18 | return (tag, rest) | 17 | return (tag, rest) |
19 | 18 | ||
20 | parseInput :: String -> Either ParseError [(String, String)] | 19 | parseInput :: String -> Either ParseError (Map String String) |
21 | parseInput = parse block "input" | 20 | parseInput s = Map.fromList <$> parse block "input" s |
22 | 21 | ||
23 | assocGet s (l:ls) = if fst l == s | 22 | doCheck :: Map String String -> Bool |
24 | then snd l | 23 | doCheck ls = all ((== True) . flip Map.member ls) requiredFields |
25 | else assocGet s ls | ||
26 | 24 | ||
27 | doCheck :: [(String, String)] -> Bool | 25 | bet :: Int -> (Int, Int) -> Bool |
28 | doCheck ls = all (isJust . flip lookup ls) fields | 26 | bet k (l, u) = k >= l && k <= u |
29 | 27 | ||
30 | checkNum lower up s = p >= lower && p <= up | 28 | validByr s = bet (read s :: Int) (1920, 2002) |
31 | where p = read s :: Int | 29 | validIyr s = bet (read s :: Int) (2010, 2020) |
32 | byr = checkNum 1920 2002 | 30 | validEyr s = bet (read s :: Int) (2020, 2030) |
33 | iyr = checkNum 2010 2020 | 31 | validEcl = flip elem eyeColors |
34 | eyr = checkNum 2020 2030 | 32 | validPid s = length s == 9 && all isDigit s |
35 | 33 | validHcl ('#':rest) = length rest == 6 && all isHexDigit rest | |
36 | parseHeight :: Parser (Int, String) | 34 | validHcl _ = False |
37 | parseHeight = do | 35 | validHgt s = |
38 | v <- many1 digit | 36 | let value = takeWhile isDigit s |
39 | unit <- choice $ map string ["cm", "in"] | 37 | unit = dropWhile isDigit s |
40 | return (read v, unit) | 38 | height = (read value :: Int, unit) |
41 | hgt s = case parse parseHeight "hgt" s of | 39 | in case height of |
42 | Right (v, "cm") -> v >= 150 && v <= 193 | 40 | (v, "cm") -> bet v (150, 193) |
43 | Right (v, "in") -> v >= 59 && v <= 76 | 41 | (v, "in") -> bet v (59, 76) |
44 | _ -> False | 42 | _ -> False |
45 | 43 | ||
46 | parseColor = char '#' >> many hexDigit | 44 | doValidity :: Map String String -> Bool |
47 | hcl :: String -> Bool | 45 | doValidity map = all ((== True) . (\(s, v) -> v $ map ! s)) ls |
48 | hcl s = case parse parseColor "hcl" s of | 46 | where ls = [ ("byr", validByr) |
49 | Right c -> length c == 6 | 47 | , ("iyr", validIyr) |
50 | Left _ -> False | 48 | , ("eyr", validEyr) |
51 | 49 | , ("hgt", validHgt) | |
52 | 50 | , ("hcl", validHcl) | |
53 | ecl :: String -> Bool | 51 | , ("ecl", validEcl) |
54 | ecl = flip elem ["amb", "blu", "brn", "gry", "grn", "hzl", "oth"] | 52 | , ("pid", validPid) |
55 | 53 | ] | |
56 | parsePid = replicateM 9 digit | ||
57 | pid :: String -> Bool | ||
58 | pid s = isRight $ parse parsePid "pid" s | ||
59 | |||
60 | doValidity :: [(String, String)] -> Bool | ||
61 | doValidity ls = all ((== True) . ($ ls)) [ byr . assocGet "byr" | ||
62 | , iyr . assocGet "iyr" | ||
63 | , eyr . assocGet "eyr" | ||
64 | , hgt . assocGet "hgt" | ||
65 | , hcl . assocGet "hcl" | ||
66 | , ecl . assocGet "ecl" | ||
67 | , pid . assocGet "pid" | ||
68 | ] | ||
69 | 54 | ||
70 | parseLines :: [String] -> [String] | 55 | parseLines :: [String] -> [String] |
71 | parseLines allLines = unwords first : next | 56 | parseLines allLines = unwords first : next |
@@ -76,7 +61,7 @@ main :: IO () | |||
76 | main = do | 61 | main = do |
77 | n <- parseLines . lines <$> readFile "input/04" | 62 | n <- parseLines . lines <$> readFile "input/04" |
78 | let blocks = map (right . parseInput) n | 63 | let blocks = map (right . parseInput) n |
64 | {- part 1 -} | ||
65 | print $ length $ filter doCheck blocks | ||
66 | {- part 2 -} | ||
79 | print $ length $ filter (\p -> doCheck p && doValidity p) blocks | 67 | print $ length $ filter (\p -> doCheck p && doValidity p) blocks |
80 | -- mapM_ print $ filter (\p -> doCheck p && doValidity p) $ map (sortOn fst) blocks | ||
81 | -- print $ length $ filter doCheck blocks | ||
82 | -- print $ length $ filter (\p -> doCheck p && doValidity p) $ map (sortOn fst) blocks | ||