aboutsummaryrefslogtreecommitdiff
path: root/execs
diff options
context:
space:
mode:
Diffstat (limited to 'execs')
-rw-r--r--execs/Day16.hs52
1 files changed, 52 insertions, 0 deletions
diff --git a/execs/Day16.hs b/execs/Day16.hs
new file mode 100644
index 0000000..88752ad
--- /dev/null
+++ b/execs/Day16.hs
@@ -0,0 +1,52 @@
1module Main where
2
3import Data.Function (on)
4import Data.List (sortBy)
5import Data.List.Split (splitOn)
6import Data.Map (Map, (!))
7import qualified Data.Map as Map
8import Data.Set (Set, (\\))
9import qualified Data.Set as Set
10import Text.Parsec.Char
11import Text.ParserCombinators.Parsec
12import Utils
13
14type Constraint = ((Int, Int), (Int, Int))
15
16parseNumber = read <$> many1 digit
17parseBound = (,) <$> parseNumber <* char '-' <*> parseNumber
18parseConstraint = (,) <$> parseBound <* string " or " <*> parseBound
19parseConstraints = (manyTill anyChar (string ": ") *> parseConstraint) `sepBy` newline
20parseTicket = parseNumber `sepBy` char ','
21parseNears = string "nearby tickets:" *> newline *> parseTicket `sepBy` newline
22parseMine = string "your ticket:" *> newline *> parseTicket
23parseInput s = do
24 let (p:q:r:_) = splitOn "\n\n" s
25 (,,) <$> parse parseConstraints "cs" p
26 <*> parse parseMine "mine" q
27 <*> parse parseNears "nears" r
28
29within (a, b) = flip bet a |+ flip bet b
30findInvalid cs = filter (\t -> not $ any (`within` t) cs)
31isValid cs = all (\t -> any (`within` t) cs)
32
33validFor :: [Constraint] -> [Int] -> Set Int
34validFor cs items = foldl1 Set.intersection (map vcf items)
35 where vcf i = Set.fromList [idx | (cons, idx) <- zip cs [0..], cons `within` i]
36
37main :: IO ()
38main = do
39 q <- parseInput <$> readFile "input/16"
40 n <- readFile "input/16"
41 let Right (cs, mine, nears) = q
42 validTickets = filter (isValid cs) nears
43 cols = map (\i -> map (!! i) validTickets) [0..length cs - 1]
44 possibleCons = sortBy (compare `on` (Set.size . snd)) $ zip [0..] $ map (validFor cs) cols
45 corresp = Map.fromList
46 $ map (\(i,v) -> (head $ Set.toList v, i))
47 $ (head possibleCons:)
48 $ zipWith fn <*> tail
49 $ possibleCons
50 where fn (i, s) (i', s') = (i', s' \\ s)
51 print $ sum $ concatMap (findInvalid cs) nears
52 print $ product $ map ((mine!!) . (corresp!)) [0..5]