{-# Language ImportQualifiedPost, QuasiQuotes #-}
{-# Options_GHC -w #-}
{-|
Module      : Main
Description : Day 16 solution
Copyright   : (c) Eric Mertens, 2020
License     : ISC
Maintainer  : emertens@gmail.com

<https://adventofcode.com/2020/day/16>

-}
module Main (main) where

import Advent
import Advent.Format (format)
import Control.Applicative (some)
import Data.List ((\\), isPrefixOf, sortOn, transpose)
import Data.Set qualified as Set
import Data.Map qualified as Map

type Range = (Integer, Integer)
type Field = ([String], [Range])

match1 :: Integer -> Range -> Bool
match1 :: Integer -> Range -> Bool
match1 Integer
x (Integer
lo,Integer
hi) = Integer
lo Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
x Bool -> Bool -> Bool
&& Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
hi

match :: Field -> Integer -> Bool
match :: Field -> Integer -> Bool
match ([[Char]]
_,[Range]
range) Integer
x = (Range -> Bool) -> [Range] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Integer -> Range -> Bool
match1 Integer
x) [Range]
range

------------------------------------------------------------------------

-- |
-- >>> :main
-- 25916
-- 2564529489989
main :: IO ()
IO ()
main =
  do ([Field]
fields, [Integer]
yourTicket, [[Integer]]
nearbyTickets) <-
       [format|2020 16
         (%s& : (%lu-%lu)&( or )%n)*%n
         your ticket:%n
         (%lu&,)%n
         %n
         nearby tickets:%n
         (%lu&,%n)*
       |]

     -- print sum of invalid fields
     Integer -> IO ()
forall a. Show a => a -> IO ()
print (Integer -> IO ()) -> Integer -> IO ()
forall a b. (a -> b) -> a -> b
$ [Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Integer
x | [Integer]
xs <- [[Integer]]
nearbyTickets, Integer
x <- [Integer]
xs, Bool -> Bool
not ((Field -> Bool) -> [Field] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Field -> Integer -> Bool
`match` Integer
x) [Field]
fields)]

     let goodTickets :: [[Integer]]
goodTickets = [[Integer]
xs | [Integer]
xs <- [[Integer]]
nearbyTickets, (Integer -> Bool) -> [Integer] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Integer
x -> (Field -> Bool) -> [Field] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Field -> Integer -> Bool
`match` Integer
x) [Field]
fields) [Integer]
xs]

         possibleFields :: t Integer -> Set [[Char]]
possibleFields t Integer
col = [[[Char]]] -> Set [[Char]]
forall a. Ord a => [a] -> Set a
Set.fromList [Field -> [[Char]]
forall a b. (a, b) -> a
fst Field
field | Field
field <- [Field]
fields, (Integer -> Bool) -> t Integer -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Field -> Integer -> Bool
match Field
field) t Integer
col]

         allCandidates :: [Set [[Char]]]
allCandidates = [[Integer] -> Set [[Char]]
forall {t :: * -> *}. Foldable t => t Integer -> Set [[Char]]
possibleFields [Integer]
col | [Integer]
col <- [[Integer]] -> [[Integer]]
forall a. [[a]] -> [[a]]
transpose [[Integer]]
goodTickets]

         -- pair up my ticket's field values with the candidate field names
         constraints :: Map Integer (Set [[Char]])
constraints = [(Integer, Set [[Char]])] -> Map Integer (Set [[Char]])
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([Integer] -> [Set [[Char]]] -> [(Integer, Set [[Char]])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer]
yourTicket [Set [[Char]]]
allCandidates)

     Integer -> IO ()
forall a. Show a => a -> IO ()
print (Integer -> IO ()) -> Integer -> IO ()
forall a b. (a -> b) -> a -> b
$ [Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [Integer
i | (Integer
i, [[Char]]
name) <- Map Integer [[Char]] -> [(Integer, [[Char]])]
forall k a. Map k a -> [(k, a)]
Map.toList ([Map Integer [[Char]]] -> Map Integer [[Char]]
forall a. HasCallStack => [a] -> a
head (Map Integer (Set [[Char]]) -> [Map Integer [[Char]]]
forall (t :: * -> *) a.
(Traversable t, Ord a) =>
t (Set a) -> [t a]
uniqueAssignment Map Integer (Set [[Char]])
constraints))
                        , [[Char]
"departure"] [[Char]] -> [[Char]] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [[Char]]
name]