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