Advent of Code 2021: Day 8 & 9Andrew Fontaine <firstname.lastname@example.org>
Another multi-day combo post! I didn’t get to start day 8 until late, and finished it with 10 minutes to spare. Thus, no time to write a post yesterday.
These elves need to maintain their stuff more. It seems the whale problem has left the seven-segment display busted.
Now… I know where this is going, and it’s going to be awful. Let’s play along though, all we have to do is find all the easy digits.
Parsing is a bit of a mess, so I’ll skip that. The end result is pretty simple though:
let find_easy list = List.filter (fun n -> let len = String.length n in len = 2 || len = 4 || len = 3 || len = 7) list let p1 = List.map (fun (_, o) -> find_easy o) input |> List.flatten |> List.length |> string_of_int
All I do is check to see if the length of the pattern matches the length of a 1, 4, 7, or 8, and count the number of times those appear.
⭐ one done!
Of course they want us to solve for all the wires.
This code is a mess, so I’m just going to start at the top and work my way in.
let group patterns = List.map (fun p -> match String.length p with | 2 -> (p, [ 1 ]) | 3 -> (p, [ 7 ]) | 4 -> (p, [ 4 ]) | 5 -> (p, [ 2; 3; 5 ]) | 6 -> (p, [ 0; 6; 9 ]) | 7 -> (p, [ 8 ]) | _ -> raise (BadPattern p)) patterns let initial_guess numbers map char = let pos = List.map (function | 0 -> [ 'a'; 'b'; 'c'; 'e'; 'f'; 'g' ] | 1 -> [ 'c'; 'f' ] | 2 -> [ 'a'; 'c'; 'd'; 'e'; 'g' ] | 3 -> [ 'a'; 'c'; 'd'; 'f'; 'g' ] | 4 -> [ 'b'; 'c'; 'd'; 'f' ] | 5 -> [ 'a'; 'b'; 'd'; 'f'; 'g' ] | 6 -> [ 'a'; 'b'; 'd'; 'e'; 'f'; 'g' ] | 7 -> [ 'a'; 'c'; 'f' ] | 8 -> [ 'a'; 'b'; 'c'; 'd'; 'e'; 'f'; 'g' ] | 9 -> [ 'a'; 'b'; 'c'; 'd'; 'f'; 'g' ] | i -> raise (BadNumber i)) numbers |> List.flatten in let possibilities = CharSet.of_list pos in CharMap.update char (function | None -> Some possibilities | Some pos -> Some (CharSet.inter pos possibilities)) map let rec construct map = function |  -> map | (pattern, numbers) :: rest -> let chars = Core.String.to_list pattern in let m = List.fold_left (initial_guess numbers) map chars in construct m rest
First, I need to parse the values into something workable. I want to turn the
patterns into a map of sets. Each character in the patterns maps to a set
containing the possibilities of what that character could actually be, so for
ab, each character would point to
cf, as they could be either
segment making up the 1.
Once that’s done, just solve 🤷
First, I need some code to actually check if the result I found is valid.
let valid_patterns = [ [ 'a'; 'b'; 'c'; 'e'; 'f'; 'g' ]; [ 'c'; 'f' ]; [ 'a'; 'c'; 'd'; 'e'; 'g' ]; [ 'a'; 'c'; 'd'; 'f'; 'g' ]; [ 'b'; 'c'; 'd'; 'f' ]; [ 'a'; 'b'; 'd'; 'f'; 'g' ]; [ 'a'; 'b'; 'd'; 'e'; 'f'; 'g' ]; [ 'a'; 'c'; 'f' ]; [ 'a'; 'b'; 'c'; 'd'; 'e'; 'f'; 'g' ]; [ 'a'; 'b'; 'c'; 'd'; 'f'; 'g' ]; ] let is_number pattern result = let num = List.map (fun x -> CharMap.find x result) pattern in List.exists (fun n -> List.for_all (fun x -> List.mem x num) n) valid_patterns let result map = CharMap.bindings map |> List.map (fun (k, v) -> (k, List.hd (CharSet.elements v))) |> List.to_seq |> CharMap.of_seq let check_patterns patterns map = let r = result map in List.for_all (fun p -> is_number p r) patterns let solved patterns map = if CharMap.for_all (fun _ v -> CharSet.cardinal v = 1) map && check_patterns patterns map then Some (result map) else None
Here, each map needs to be pointing to a single character, and I check to make sure each number is possible given the mapping I’ve found.
Next, I need some code that actually comes up with a solution:
let rec solver patterns map = match CharMap.bindings map |> List.filter (fun (_, v) -> CharSet.cardinal v <> 1) with |  -> solved patterns map | ms -> let key, guesses = List.fold_left (fun (k1, g1) (k2, g2) -> if CharSet.cardinal g1 < CharSet.cardinal g2 && CharSet.cardinal g1 <> 1 then (k1, g1) else (k2, g2)) (List.hd ms) (List.tl ms) in List.find_map (fun c -> let new_map = CharMap.mapi (fun k v -> if k = key then CharSet.singleton c else CharSet.remove c v) map in match solver patterns new_map with None -> None | Some m -> Some m) (CharSet.elements guesses)
Okay, here we go. First, I only want all the “not solved” characters. If I don’t have any “not solved” characters, I have a solution! I check if it is correct.
If I’m not done yet… I find the “most solved” character. The one with the least number of options.
Once I pick one, for each of its possible solutions, I construct a state assuming I am correct.
I take that possible solution and pass it back into my solver function. This continues until the first conditional is met and I check if I am right. If not, I construct a state with the next possible solution. Eventually, I am right.
The rest of the code is taking the solution, decoding the output, and finding the final answer:
let decode_code result code = let pattern = List.map (fun x -> CharMap.find x result) code in let numbers = List.mapi (fun i n -> (i, n)) valid_patterns in List.find_map (fun (i, n) -> if List.length pattern = List.length n && List.for_all (fun x -> List.mem x n) pattern then Some i else None) numbers let decode codes result = codes |> List.map Core.String.to_list |> List.map (decode_code result) let compute patterns codes = let map = patterns |> group |> construct CharMap.empty in let p = List.map Core.String.to_list patterns in match solver p map with | None -> [ None ] | Some result -> decode codes result let p2 = List.fold_left (fun s (patterns, codes) -> let r = compute patterns codes in let n = List.map (function | None -> raise (BadPattern "BLAH") | Some i -> char_of_int (i + zero)) r |> Core.String.of_char_list in int_of_string n + s) 0 input |> string_of_int
That’s day eight ✔️
Today was slightly easier, thankfully. This isn’t being written 10 minutes to midnight.
It turns out those case are lava tubes. yay.
The first problem is to find the lowest points of the caves, to avoid the smoke easier. I must find all the points where each adjacent point is higher.
Once parsing the output is out of the way, the solution is simple:
type coords = int * int module Coords = struct type t = coords let compare (x1, y1) (x2, y2) = if x1 < x2 then -1 else if x1 > x2 then 1 else if y1 < y2 then -1 else if y1 > y2 then 1 else 0 end module TupleMap = Map.Make (Coords) let parse = let width = List.hd input |> List.length in let height = List.length input in let with_index = List.mapi (fun i r -> (i, List.mapi (fun j c -> (j, c)) r)) input in ( width, height, List.fold_left (fun m (i, r) -> List.fold_left (fun n (j, c) -> TupleMap.add (i, j) c n) m r) TupleMap.empty with_index ) let low_points (width, height, map) = TupleMap.filter (fun (i, j) c -> let n = if i = 0 then 9 else TupleMap.find (i - 1, j) map in let s = if i = height - 1 then 9 else TupleMap.find (i + 1, j) map in let w = if j = 0 then 9 else TupleMap.find (i, j - 1) map in let e = if j = width - 1 then 9 else TupleMap.find (i, j + 1) map in c < n && c < s && c < e && c < w) map let p1 = let results = low_points parse in TupleMap.fold (fun _ c sum -> c + 1 + sum) results 0 |> string_of_int
I take the integers and put them into a map where the coordinate of the point points to the height of the point. Then, I filter through all the points, checking for bounds, and ensuring all adjacent points are higher. Once the lower points are found, I calculate the “total risk value”.
⭐ one done!
Oh, so the low points make up basins. I think it’s pretty amazing how they
manage to create the input required for these problems. A basin is a group of
points bordered by the boundary or the highest point (a
Good thing I have code that already finds the lowest points! I’m going to need a set to better keep track of what is in the basin, but the rest didn’t take too much to work out:
module TupleSet = Set.Make (Coords) let rec find_basin width height m (i, j) acc = if TupleMap.find (i, j) m = 9 then acc else if TupleSet.mem (i, j) acc then acc else let new_acc = TupleSet.add (i, j) acc in let n = if i <> 0 then find_basin width height m (i - 1, j) new_acc else new_acc in let s = if i + 1 < height then find_basin width height m (i + 1, j) n else n in let w = if j <> 0 then find_basin width height m (i, j - 1) s else s in let e = if j + 1 < width then find_basin width height m (i, j + 1) w else w in TupleSet.union n (TupleSet.union s (TupleSet.union w e)) let basins = let w, h, m = parse in let finder = find_basin w h m in let low = low_points (w, h, m) in TupleMap.mapi (fun (i, j) _ -> finder (i, j) TupleSet.empty) low let p2 = let results = basins in TupleMap.fold (fun _ v m -> TupleSet.cardinal v :: m) results  |> List.sort (fun x y -> y - x) |> List.filteri (fun i _ -> i < 3) |> List.fold_left (fun x y -> x * y) 1 |> string_of_int
For each of the lowest points, I recursively map out the area surrounding the point, adding it to the set containing all the points of the basin. If I hit a boundary or a ‘9’, I stop.
Once all the basins are found, the solution is a matter of finding the 3 biggest, and finding the product of them.
I think problems like this one are a lot of fun. It’s a great use of recursion, and a set makes it easy to keep track of where I’ve visited.
Solvers like in day 8 are fun, too, but it makes such a mess of code. I am sure it could be cleaner somehow, but 10 minutes to midnight is not the time for cleanup 😅
Want to discuss this post?
Reach out via email to ~email@example.com, and be sure to follow the mailing list etiquette.Other posts