Advent of Code 2021: Day 8 & 9

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.

Day 8

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!

Part 2

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 the pattern 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 ✔️

Day 9

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!

Part 2

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 9).

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 ~afontaine/blog-discuss@lists.sr.ht, and be sure to follow the mailing list etiquette.