Advent of Code: Days 4, 5, 6

Andrew Fontaine <andrew@afontaine.ca>

I’ve been busy so this is going to be a bit longer but also contain 3 whole solutions!

Day four

Diving deeper and deep, we come across a giant squid! To distract it, we decide to play bingo.

An important rule to this game of bingo is that diagonals don’t count, and don’t need to be considered. I am given a set of calls and boards, and need to figure out which board will win first.

Step one is parsing the input. The first line contains the calls for the game, and the rest of the file consists of separate boards. As I want to be able to keep track if whether or not a number has been called, I make a type to hold that information. Then, I split up the file to the different boards:

exception Empty

type i = Marked of int | Unmarked of int

let add_to_board line = function
  | [] -> [ [ line ] ]
  | last :: rest -> (line :: last) :: rest

let parse_line line =
  String.split_on_char ' ' line
  |> List.filter (fun s -> s <> "")
  |> List.map (fun s -> Unmarked (int_of_string s))

let input =
  match Core.In_channel.read_lines "./priv/2021/D04" with
  | [] -> raise Empty
  | calls :: rest ->
      let boards =
        List.fold_left
          (fun b l ->
            match l with
            | "" | "\n" -> [] :: b
            | line -> add_to_board (parse_line line) b)
          [ [] ] rest
  |> List.filter (fun x -> x <> [])
      in
      let numbers = List.map int_of_string (String.split_on_char ',' calls) in
      (numbers, boards)

My type i indicates whether or not a number has been marked. Because ocaml requires exhaustive pattern matching, I have to make sure my list of lines from the file is not empty. Then, I pull the first line out with pattern matching (noted as calls here), and fold over the rest of the list to construct the boards. There are a few empty lines in there that need to be filtered out. Finally, I split the calls on commas, and parse those strings into proper numbers.

Part one just requires I play the game on all the boards. There are some small helper functions I need first:

let check_wins board =
  let row_win =
    List.exists
      (fun row ->
        List.for_all
          (fun m -> match m with Marked _ -> true | Unmarked _ -> false)
          row)
      board
  in
  let column_win =
    List.exists
      (fun i ->
        List.for_all
          (fun row ->
            match List.nth row (i - 1) with Marked _ -> true | Unmarked _ -> false)
          board)
      (List.init (List.length (List.nth board 0)) (fun x -> x + 1))
  in
  row_win || column_win

let mark i board =
  List.map
    (fun row ->
      List.map
        (fun x -> match x with Unmarked y when y = i -> Marked y | y -> y)
        row)
    board

check_wins checks to see if any row or column has been completely marked, and mark updates the board to set a number to Marked if it is found.

All that is left is to play and compute the score:

let compute_score board call =
  let sum =
    List.fold_left
      (fun sum row ->
        List.fold_left
          (fun s x -> match x with Marked _ -> s | Unmarked y -> s + y)
          sum row)
      0 board
  in
  call * sum

let rec play boards = function
  | [] -> -100
  | call :: rest -> (
      let marks = mark call in
      let b = List.map marks boards in
      match List.find_opt check_wins b with
      | None -> play b rest
      | Some board -> compute_score board call)

let p1 =
  let calls, boards = input in
  play boards calls |> string_of_int

play recursively iterates over the called numbers, marking boards until a winner is found. It returns the score of -100 if I run out of numbers make it obvious (while still an integer) that something went wrong. While not the best error handling method, it works for such a small script. For more complicated problems later on, I plan on looking to Vladimir Keleshev’s Composable Error Handling in OCaml for guidance.

Once a winner is found, the score is computed. ⭐ one done!

Part two

Part two is a small extension to part one, which suggests that I should pick the board that will win last to ensure the squid wins and won’t crush us for losing. As such, it only requires some small extension.


let rec play boards = function
  | [] -> -100
  | call :: rest -> (
      let marks = mark call in
      let new_boards = List.map marks boards in
      match new_boards with
      | [] -> -100
      | [b] -> if check_wins b then compute_score b call else play [b] rest
      | boards -> let losers = List.filter (fun b -> not (check_wins b)) boards in
          play losers rest)


let p2 =
  let calls, boards = input in
  play boards calls |> string_of_int

Instead of stopping as soon as a winner is found, I continue until only one board is left to win.

That’s day four ✔️

Day 5

Every year involves at least one problem about interesting lines. Every one of them is a pain to solve.

This year, the submarine is avoiding large, opaque clouds spewing out of hydrothermal vents on the ocean floor. Fortunately for us, the vents exist in extremely straight lines.

I first attempted to do this the mathematically clever way using the determinant of the two lines and solving for their intersection point, if any, but that turned into a total bust that I could not puzzle out and so I shall speak no more of it.

Instead, it was simply easier to walk the line segments and remember all the points I’ve been.

OCaml handles generic data structures such as maps and sets via a functor, which is a function that takes and returns a module instead of normal values. To make a set module, the functor Set.Make is used. Set.Make takes a module that specifies a type, t, and a function to compare values, compare. This is a module type named OrderedType, where t is the type to order, and compare lets us order them. I set up a set to track the points I’ve been as so:

type point = Point of int * int

module PointSet = Set.Make (struct
  type t = point

  let compare (Point (x1, y1)) (Point (x2, y2)) =
    if x1 < x2 then -1
    else if x1 = x2 then if y1 < y2 then -1 else if y1 = y2 then 0 else 1
    else 1
end)

compare returns -1 if the first point has a smaller x value, 1 if a larger x value, and defers to the y value if equal. If both are equal, 0 is returned. This is how the set knows if it already has the given point.

I also need a line type to keep track of all my points:

type line = Line of point * point

As the first problem only requires I deal with horizontal and vertical lines, that should be quick to set up:

let is_vertical (Line (Point (_, y1), Point (_, y2))) = y1 = y2

let is_horizontal (Line (Point (x1, _), Point (x2, _))) = x1 = x2

let is_p1 line = is_vertical line || is_horizontal line

All that’s left is to walk the lines:

let walk_line acc (Line (Point (x1, y1), Point (x2, y2))) =
  let points =
    if x1 = x2 then
      List.init (abs (y2 - y1) + 1) (fun y -> Point (x1, min y1 y2 + y))
    else
      List.init (abs (x2 - x1) + 1) (fun x -> Point (min x1 x2 + x, y1))
  in
  List.fold_left
    (fun (s1, s2) point ->
      if PointSet.mem point s1 then (s1, PointSet.add point s2)
      else (PointSet.add point s1, s2))
    acc points

let walk_lines lines =
  List.fold_left walk_line (PointSet.empty, PointSet.empty) lines

let p1 =
  let _, points = input |> List.filter is_p1 |> walk_lines in
  points |> PointSet.elements |> List.length |> string_of_int

walk_line makes a list covering every point contained in the line, and then adds them to the visited set. If the point is already in the visited set, it is added to the final set, as it matches our criteria.

walk_lines iterates over all the lines, until the final set of points is found.

⭐ one done!

Part two

Part two, again, is only a small extension of part one. It demands we include the diagonal lines to check as well. Simple enough to add to walk_line

let walk_line acc (Line (Point (x1, y1), Point (x2, y2))) =
  let points =
    if x1 = x2 then
      List.init (abs (y2 - y1) + 1) (fun y -> Point (x1, min y1 y2 + y))
    else if y1 = y2 then
      List.init (abs (x2 - x1) + 1) (fun x -> Point (min x1 x2 + x, y1))
    else
      List.init
        (abs (x2 - x1) + 1)
        (fun z ->
          let x = if x1 < x2 then x1 + z else x1 - z in
          let y = if y1 < y2 then y1 + z else y1 - z in
          Point (x, y))
  in
  List.fold_left
    (fun (s1, s2) point ->
      if PointSet.mem point s1 then (s1, PointSet.add point s2)
      else (PointSet.add point s1, s2))
    acc points

The else expression now knows how to follow along a diagonal! Then to just run walk_lines on the whole dataset and count up the points:

let p2 =
  let _, points = input |> walk_lines in
  points |> PointSet.elements |> List.length |> string_of_int

That’s day five ✔️

Day six

Day six requires we do some biological work by counting fish.

Part one is simple enough, so let’s write some code for it:

let rec grow_fish old_fish new_fish = function
  | [] -> List.rev_append old_fish new_fish
  | h :: rest ->
      if h = 0 then grow_fish (6 :: old_fish) (8 :: new_fish) rest
      else grow_fish ((h - 1) :: old_fish) new_fish rest

let p1_sol input count =
  List.init count (fun x -> x + 1)
  |> List.fold_left (fun fish _ -> grow_fish [] [] fish) input

let p1 =
  let sol = p1_sol input 80 |> List.length in
  Int.to_string sol

For 80 iterations, I go through the list of fish, decrementing the days til spawn. Once it hits 0, I bump it back up to 6 and add a new fish with a countdown starting at 8. All that’s left is to count up the fish!

⭐ one done!

Part two

I was hopeful I could just run my code for 256 days, but soon realized why it was a “part two”: bottlenecks and stack overflows.

The list was growing so much that my original solution to part one (not posted) would blow up with a stack overflow. The one posted above is tail-call optimized, as I thought it would be my only issue. Turns out, it was also growing so much that iterating through the list for ever day took ages.

Back to the drawing board.

I had noticed a lot of the fish ended up on the same cycle. There were several fish that each had 0 to 8 days left on their spawn timers, which got me thinking… if I could group the fish, I wouldn’t have to add to the list and instead just increment the count!

I initially started off trying to make a map to handle this, but as I don’t quite understand how ocaml’s maps worked, it was easier for me to use a list of tuples instead. I also needed to be able to update both the key and the value, so a tuple felt better.

let update x up list = up (List.find_opt (fun (y, _) -> x = y) list)

let dedup list =
  List.fold_left
    (fun deduped (x, z) ->
      update x
        (function
          | None -> (x, z) :: deduped
          | Some (_, y) -> (x, y + z) :: List.filter (fun (a, _) -> x <> a) deduped)
        deduped)
    [] list

let grow_fish_2 fishes _ =
  List.fold_left
    (fun fish (x, y) ->
      match x with 0 -> (6, y) :: (8, y) :: fish | z -> (z - 1, y) :: fish)
    [] fishes
  |> dedup

let p2_sol (input : int list) count =
  let fishes =
    List.fold_left
      (fun fishes x ->
        update x
          (function
            | None -> (x, 1) :: fishes
            | Some (_, y) ->
                (x, y + 1) :: List.filter (fun (y, _) -> x <> y) fishes)
          fishes)
      [] input
  in
  List.init count (fun x -> x + 1)
  |> List.fold_left grow_fish_2 fishes
  |> List.fold_left (fun sum (_, x) -> sum + x) 0

update replicates map’s update function, where you provide a function that takes an option type. The option type either contains the value the key is pointing to, or nothing, and you must handle both cases. dedup takes all the elements and buckets and merges the matching ones together again.

grow_fish_2, then, goes over the list of fish, decrementing the number of days til they spawn. If they are 0, the number gets bumped back up to 6, and a new tuple of fish is added. This tuple starts at 8, their spawn countdown, and the same number of fish as was in the first bucket. Once that is complete, I dedup the buckets, as it was easier to dedup the list once the fish spawning was done.

I repeat this for the 256 days to get… 1.73e12 fish!

That’s a lot of fish!

I’m trying to stay on top of these posts this year, but the weekends are hectic, as usual. I hope to not have to cram 3 days of updates in one day again though!


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.

Other posts