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 @@
+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]