aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--aoc.cabal2
-rw-r--r--execs/Day04.hs93
-rw-r--r--input/04sample26
3 files changed, 66 insertions, 55 deletions
diff --git a/aoc.cabal b/aoc.cabal
index dda4a43..4b92bb7 100644
--- a/aoc.cabal
+++ b/aoc.cabal
@@ -36,6 +36,6 @@ executable Day03
36 36
37executable Day04 37executable Day04
38 main-is: Day04.hs 38 main-is: Day04.hs
39 build-depends: base, parsec 39 build-depends: base, parsec, containers
40 default-language: Haskell2010 40 default-language: Haskell2010
41 hs-source-dirs: execs 41 hs-source-dirs: execs
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
diff --git a/input/04sample b/input/04sample
new file mode 100644
index 0000000..81712b3
--- /dev/null
+++ b/input/04sample
@@ -0,0 +1,26 @@
1eyr:1972 cid:100
2hcl:#18171d ecl:amb hgt:170 pid:186cm iyr:2018 byr:1926
3
4iyr:2019
5hcl:#602927 eyr:1967 hgt:170cm
6ecl:grn pid:012533040 byr:1946
7
8hcl:dab227 iyr:2012
9ecl:brn hgt:182cm pid:021572410 eyr:2020 byr:1992 cid:277
10
11hgt:59cm ecl:zzz
12eyr:2038 hcl:74454a iyr:2023
13pid:3556412378 byr:2007
14
15pid:087499704 hgt:74in ecl:grn iyr:2012 eyr:2030 byr:1980
16hcl:#623a2f
17
18eyr:2029 ecl:blu cid:129 byr:1989
19iyr:2014 pid:896056539 hcl:#a97842 hgt:165cm
20
21hcl:#888785
22hgt:164cm byr:2001 iyr:2015 cid:88
23pid:545766238 ecl:hzl
24eyr:2022
25
26iyr:2010 hgt:158cm hcl:#b6652a ecl:blu byr:1944 eyr:2021 pid:093154719