advent21/src/advent21.hs

   1 -- import Debug.Trace
   2
   3 -- import Data.Text (Text)
   4 -- import qualified Data.Text as T
   5 import qualified Data.Text.IO as TIO
   6
   7 import Data.Attoparsec.Text hiding (take)
   8 -- import Data.Attoparsec.Combinator
   9 -- import Control.Applicative
  10 -- import Control.Applicative.Combinators
  11
  12 import qualified Data.Set as S
  13 import qualified Data.Map.Strict as M
  14 import Data.List
  15 import Control.Monad.CSP
  16
  17
  18 type Ingredient = String
  19 type Allergen = String
  20 data Food = Food
  21   { ingredients :: S.Set Ingredient
  22   , allergens :: S.Set Allergen
  23   } deriving (Show, Eq)
  24
  25 type CandidateIngredients = M.Map Allergen (S.Set Ingredient)
  26
  27
  28
  29 main :: IO ()
  30 main =
  31   do  text <- TIO.readFile "data/advent21.txt"
  32       let foods = successfulParse text
  33       let candidates = M.unionsWith S.intersection $ map allergenMap foods
  34       -- print candidates
  35       print $ part1 candidates foods
  36       putStrLn $ part2 candidates
  37
  38
  39 part1 candidates foods = sum $ map countSafe foods
  40   where possibleAllergens = S.unions $ M.elems candidates
  41         countSafe food = S.size $ (ingredients food) `S.difference` possibleAllergens
  42
  43 part2 candidates = intercalate "," $ map snd $ sortOn fst assignments
  44   where assignments = knownAllergens candidates
  45
  46
  47 allergenMap :: Food -> CandidateIngredients
  48 allergenMap food = M.fromList $ S.toList $ S.map (, ingredients food) $ allergens food
  49
  50 knownAllergens :: CandidateIngredients -> [(Allergen, Ingredient)]
  51 knownAllergens candidates = zip allergens assignedIngredients
  52   where
  53     (allergens, possibleIngredients) = unzip $ M.toList candidates
  54     assignedIngredients = solveAllergens $ map S.toList possibleIngredients
  55
  56 solveAllergens :: [[Ingredient]] -> [Ingredient]
  57 solveAllergens possibleIngredients = oneCSPSolution $ do
  58   dvs <- mapM mkDV possibleIngredients
  59   mapAllPairsM_ (constraint2 (/=)) dvs
  60   return dvs
  61
  62 mapAllPairsM_ :: Monad m => (a -> a -> m b) -> [a] -> m ()
  63 mapAllPairsM_ _f []     = return ()
  64 mapAllPairsM_ _f (_:[]) = return ()
  65 mapAllPairsM_  f (a:l)  = mapM_ (f a) l >> mapAllPairsM_ f l
  66
  67
  68 -- Parse the input file
  69
  70 foodsP = foodP `sepBy` endOfLine
  71 foodP = Food <$> ingredientsP <* " (contains " <*> allergensP <* ")"
  72
  73 ingredientsP = S.fromList <$> (many1 letter) `sepBy` (many1 space)
  74 allergensP = S.fromList <$> (many1 letter) `sepBy` (string ", ")
  75
  76
  77 -- successfulParse :: Text -> (Integer, [Maybe Integer])
  78 successfulParse input =
  79   case parseOnly foodsP input of
  80     Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
  81     Right foods -> foods