From 28091a3489732f42bf7419c6fcc6f0a3d1c674fc Mon Sep 17 00:00:00 2001
From: Akshay <nerdy@peppe.rs>
Date: Wed, 16 Dec 2020 16:40:23 +0530
Subject: add initial day16 solution

---
 execs/Day16.hs | 52 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 52 insertions(+)
 create mode 100644 execs/Day16.hs

(limited to 'execs')

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]
-- 
cgit v1.2.3