aboutsummaryrefslogtreecommitdiff
path: root/execs
diff options
context:
space:
mode:
Diffstat (limited to 'execs')
-rw-r--r--execs/Day04.hs93
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 @@
1module Main where 1module Main where
2 2
3import Text.ParserCombinators.Parsec 3import Text.ParserCombinators.Parsec
4import Text.Parsec.Char 4import Data.Map.Strict (Map, (!))
5import Data.Either 5import qualified Data.Map.Strict as Map
6import Data.Maybe 6import Data.Char (isDigit, isHexDigit)
7import Control.Monad
8import Data.List (sortOn)
9 7
10right (Right a) = a 8right (Right a) = a
11fields = [ "byr" , "iyr" , "eyr" , "hgt" , "hcl" , "ecl" , "pid" ] 9requiredFields = [ "byr" , "iyr" , "eyr" , "hgt" , "hcl" , "ecl" , "pid" ]
10eyeColors = ["amb", "blu", "brn", "gry", "grn", "hzl", "oth"]
12 11
13block = cell `sepBy` oneOf " \n" 12block = cell `sepBy` oneOf " \n"
14cell = do 13cell = 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
20parseInput :: String -> Either ParseError [(String, String)] 19parseInput :: String -> Either ParseError (Map String String)
21parseInput = parse block "input" 20parseInput s = Map.fromList <$> parse block "input" s
22 21
23assocGet s (l:ls) = if fst l == s 22doCheck :: Map String String -> Bool
24 then snd l 23doCheck ls = all ((== True) . flip Map.member ls) requiredFields
25 else assocGet s ls
26 24
27doCheck :: [(String, String)] -> Bool 25bet :: Int -> (Int, Int) -> Bool
28doCheck ls = all (isJust . flip lookup ls) fields 26bet k (l, u) = k >= l && k <= u
29 27
30checkNum lower up s = p >= lower && p <= up 28validByr s = bet (read s :: Int) (1920, 2002)
31 where p = read s :: Int 29validIyr s = bet (read s :: Int) (2010, 2020)
32byr = checkNum 1920 2002 30validEyr s = bet (read s :: Int) (2020, 2030)
33iyr = checkNum 2010 2020 31validEcl = flip elem eyeColors
34eyr = checkNum 2020 2030 32validPid s = length s == 9 && all isDigit s
35 33validHcl ('#':rest) = length rest == 6 && all isHexDigit rest
36parseHeight :: Parser (Int, String) 34validHcl _ = False
37parseHeight = do 35validHgt 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)
41hgt 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
46parseColor = char '#' >> many hexDigit 44doValidity :: Map String String -> Bool
47hcl :: String -> Bool 45doValidity map = all ((== True) . (\(s, v) -> v $ map ! s)) ls
48hcl 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)
53ecl :: String -> Bool 51 , ("ecl", validEcl)
54ecl = flip elem ["amb", "blu", "brn", "gry", "grn", "hzl", "oth"] 52 , ("pid", validPid)
55 53 ]
56parsePid = replicateM 9 digit
57pid :: String -> Bool
58pid s = isRight $ parse parsePid "pid" s
59
60doValidity :: [(String, String)] -> Bool
61doValidity 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
70parseLines :: [String] -> [String] 55parseLines :: [String] -> [String]
71parseLines allLines = unwords first : next 56parseLines allLines = unwords first : next
@@ -76,7 +61,7 @@ main :: IO ()
76main = do 61main = 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