day21.md

Day 21

all / 1 / 2 / 3 / 4 / 5 / 6 / 7 / 8 / 9 / 10 / 11 / 12 / 13 / 14 / 15 / 16 / 17 / 18 / 19 / 20 / 21 / 22 / 23 / 24 / 25

Available as an RSS Feed

Prompt / Code / Rendered

Another nice self-contained constraint satisfaction problem, along the lines of Day 16 :) Actually, after solving this one, I went back and rewrote my day 16 solution in terms of a common solver function that works for both!

-- | Given a map of @k@ to possible @a@s for that @k@, find possible
-- configurations where each @k@ is given its own unique @a@.
pickUnique :: (Ord k, Ord a) => [(k, Set a)] -> [Map k a]
pickUnique mp = flip evalStateT S.empty $ do
    fmap M.fromList . for opts . traverse $ \poss -> do
      seen <- get
      pick <- lift $ S.toList (poss `S.difference` seen)
      pick <$ modify (S.insert pick)
  where
    opts = sortOn (S.size . snd) mp

It uses StateT over list, like I described in a constraint solving blog post. Basically it explores all of the possibilities of drawing from a state of "items left-over to assign". The state is a Set a of items not yet picked, and at every step we non-deterministically pick an a out of the given (k, Set a) of options that hasn't already been chosen. We use that pick and add that picked item to the picked item set along that branch.

We also sort by the size of the possibility set for each k, because starting with smaller possibilities keeps our tree tight at the top, instead of wide --- we can eliminate options much more quickly.

Now all we need to do is to get our information into a [(k, Set a)]. In our case, this is [(String, Set String)] -- with each allergen, associate a set of possible foods they might be associated with.

We can do this by just taking an intersection of all the possibilities on each line:

assembleOptions
    :: (Ord k, Ord a)
    => [(Set a, Set k)] -- set of foods, set of allergens
    -> Map k (Set a)    -- each allergen with the foods they were seen with in all occurrences
assembleOptions info = M.unionsWith S.intersection $
    [ M.fromSet (const igr) alg   -- a map of allergens to all foods they were seen with in this item
    | (igr, alg) <- info
    ]

We generate a list of allergens to all foods they were seen with on each item, and then intersect all of those foods within an allergen, so that our final Map k (Set a) matches each k allergen with a set ofall foods that were present in all of the occurrences of each allergen.

Now part 2 is basically just reading off the results of pickUnique

part2 :: [(Set String, Set String)] -> Maybe [String]
part2 = fmap M.elems . listToMaybe . pickUnique . assembleOptions

We definitely have a nice advantage here in that the Map String String (the result map of allergens to foods) already is sorted in order of allergens (alphabetically), so no need to do anything other than just M.elems :)

Part 1 is definitely slightly more complicated: not only do we need to find the allergenic foods, we have to count the occurrences of non-allergenic foods in all the items:

part2 :: [(Set String, Set String)] -> Maybe Int
part2 info = do
    allergenicFoods <- fmap (S.fromList . M.elems)
                     . listToMaybe
                     . pickUnique
                     . assembleOptions
                     $ info
    pure . sum $
      [ length $ filter (`S.notMember` allergenicFoods) foods
      | (foods, _) <- info
      ]
  where
    allFoodOccurrences :: [String]
    allFoodOccurrences = concatMap (S.toList . fst) info

Back to all reflections for 2020

Day 21 Benchmarks

>> Day 21a
benchmarking...
time                 270.6 μs   (267.0 μs .. 277.0 μs)
                     0.997 R²   (0.994 R² .. 0.999 R²)
mean                 273.1 μs   (269.2 μs .. 283.4 μs)
std dev              22.37 μs   (8.162 μs .. 40.92 μs)
variance introduced by outliers: 71% (severely inflated)

* parsing and formatting times excluded

>> Day 21b
benchmarking...
time                 162.9 μs   (160.4 μs .. 165.9 μs)
                     0.997 R²   (0.994 R² .. 1.000 R²)
mean                 160.2 μs   (158.4 μs .. 165.3 μs)
std dev              9.685 μs   (3.385 μs .. 17.84 μs)
variance introduced by outliers: 59% (severely inflated)

* parsing and formatting times excluded