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!
]]>
