Advent of Code 2020 in Haskell

Jump to:

D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 | D9 | D10 | D11 | D12 | D13 | D14 | D15 | D16 | D17 | D18 | D19 | D20 | D21 | D22 | D23 | D24 | D25

Part 1

Thankfully, Day 21 dials the intensity back down after the tile-arranging madness that was Day 20. We need to analyze a list of ingredients with potential allergens, with the aim of identifying which ingredient contains which allergen. We are told that each allergen is found in exactly one ingredient.

Part 1, however, asks us only to rule out which ingredients could not possibly be allergen-containing. As a first step, we will determine the converse: which ingredients could correspond to the first allergen, which could correspond to the second, etc. For each allergen, this amounts to taking the set intersection of all ingredient lists that contain the allergen.

    
import D21input
-- input :: [IngredientList]
import Data.List as List
import Data.Map.Strict as Map
import Data.Set as Set

type IngredientList = ([String], [String])
type PossStrings = Map.Map String (Set.Set String)

addRow :: IngredientList -> PossStrings -> PossStrings
addRow (_, []) acc = acc
addRow (is, (a:as)) acc = 
    Map.insertWith Set.intersection a (Set.fromList is) (addRow (is, as) acc)

getPossAllergens :: PossStrings -> Set.Set String
getPossAllergens = Map.foldr Set.union Set.empty

getAllIngredients :: [IngredientList] -> [String]
getAllIngredients l = List.concat $ List.map fst l

solve :: Int
solve = let allergenMap = List.foldr addRow Map.empty input
            possAllergens = getPossAllergens allergenMap
            allIngredients = getAllIngredients input
            isPossAllergen = ((flip Set.member) possAllergens)
            allSafe = List.filter (not . isPossAllergen) allIngredients
            in List.length allSafe

main :: IO ()
main = print $ solve

We will aim to build a map associating each allergen with the set of possible ingredients (called PossStrings above). With insertWith, accumulating all of the lists in the input into this map is actually fairly easy. addRow is the function that folds the next input string into the map. For each allergen in the string, we will intersect the ingredient list with what is already in the map. The main solve function passes this to foldr to parse the entire input into allergenMap.

Here is what allergenMap looks like on my input:

    
fromList [("dairy",fromList ["clzpsl","fqhpsl","zbbnj"]),
          ("eggs",fromList ["dzqc","fqhpsl","zxncg"]),
          ("fish",fromList ["clzpsl","zbbnj"]),
          ("nuts",fromList ["zbbnj"]),
          ("peanuts",fromList ["jkgbvlxh","ppj","zbbnj"]),
          ("sesame",fromList ["clzpsl","dzqc","fqhpsl","zbbnj"]),
          ("soy",fromList ["dzqc","fqhpsl","ppj","zxncg"]),
          ("wheat",fromList ["fqhpsl","glzb"])]

From there, the remainder of part 1 is easy. getPossAllergens performs a foldr over the values of the allergenMap, using set union to obtain a set of all ingredients that could be allergen-containing. getAllIngredients concatenates all ingredients in the input into one large list (without filtering for duplicates, since we will need the duplicates to answer the question).

The rest of the solve function then filters out all ingredients that could be an allergen and returns the length.

Part 2

Part 2 asks us to now identify the exact ingredient that contains each allergen. Fortunately, this is made easy by the work we did to create allergenMap in part 1.

It's made even easier if we recognize that, given allergenMap, we can use the same backtracking algorithm employed in Day 16 to assign one ingredient to each allergen. In Day 16, we needed to decide on a position for each field without repeating a position, and we had obtained a list of possible positions for each field. Here, we need to decide on an ingredient for each allergen without repeating an ingredient, and we have obtained a list of possible ingredients for each allergen.

    
import D21input
-- input :: [IngredientList]
import Control.Monad
import Data.List as List
import Data.Map.Strict as Map
import Data.Set as Set

type IngredientList = ([String], [String])
type PossStrings = Map.Map String (Set.Set String)

addRow :: IngredientList -> PossStrings -> PossStrings
addRow (_, []) acc = acc
addRow (is, (a:as)) acc = 
    Map.insertWith Set.intersection a (Set.fromList is) (addRow (is, as) acc)

addAssignment :: [String] -> (String, Set.Set String) -> [[String]]
addAssignment curr (_, is) =
    [next:curr | next <- (Set.toList is) List.\\ curr]

solve :: String
solve = let allergenMap = List.foldr addRow Map.empty input
            ingredients = reverse $ head $ foldM addAssignment [] (Map.toList allergenMap)
            in intercalate "," ingredients

main :: IO ()
main = print $ solve

Actually, looking at allergenMap above, it is surprisingly small enough that we could even solve this by hand. Even so, I must mention that this could also be viewed as a matching problem on a bipartite graph, with allergens as vertices on one side, ingredients as vertices on the other, and an edge between an allergen vertex and ingredient vertex iff the ingredient could be the one containing the allergen. Running a bipartite matching algorithm on this graph would also yield our desired assignment.

Jump to:

D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 | D9 | D10 | D11 | D12 | D13 | D14 | D15 | D16 | D17 | D18 | D19 | D20 | D21 | D22 | D23 | D24 | D25

Advent of Code 2020 in Haskell - Day 21

12-27-2020

Part 1

Part 2