Advent of Code '22 in OCaml, Week 3
Posted: 2022-12-23
Advent of Code ‘22 days 11 through 17 definitely stepped up the difficulty. Lack of sleep started to catch up with me, but the puzzles have been fun!
Day 11
The elves are nowhere to be found. Instead, we’re caught up in some monkey business.
The first part of this puzzle involved straightforwardly implementing the
algorithm described in the question. My initial parsing wasn’t beautiful. I
didn’t know about
List.nth_exn,
and after finding it I was able to clean up quite a bit.1
I struggled to reach the solution to part b. I spent time on a naive approach
which just plugged in a bigint, even though I suspected it wouldn’t work since
one of the monkeys squares its input. But OCaml bigints are kind of hidden and
discouraged. Big_int.big_int is declared but not implemented in the runtime,
so this was a big slow dead end and I didn’t even really get to try it.
I noticed shortly after my bigint adventure that all the monkey divisors were prime.
It took me another hour to realize that the way to shrink the value while
maintaining its divisibility properties was score % (product-of-primes). I was
fixated on finding a way to use division, which was never going to work since
some of the monkeys add their operands.
However, my test against the sample still wouldn’t pass. I had hardcoded the product of the first eight primes as the modulus, and it took me about 15 minutes to notice that the sample input had a divisor of 23, the ninth prime!
- Part a: 00:22:36, rank 782
- Part b: 01:36:51, rank 4871
- Commit
1type monkey = {
2 items : int list;
3 op : int -> int;
4 to_monkey : score:int -> int;
5 inspections : int;
6}
7
8let do_monkey1 ms id =
9 let m = ms.(id) in
10 List.iter m.items ~f:(fun score ->
11 let score = m.op score / 3 in
12 let tom = m.to_monkey ~score in
13 ms.(tom) <- { (ms.(tom)) with items = ms.(tom).items @ [ score ] });
14 ms.(id) <-
15 { m with items = []; inspections = m.inspections + List.length m.items }
16
17let parta ls =
18 let sections = Input.to_sections ls in
19 let ms = Array.of_list_map sections ~f:mk_monkey in
20 for _ = 1 to 20 do
21 for i = 0 to Array.length ms - 1 do
22 do_monkey1 ms i
23 done
24 done;
25 Array.sort ms ~compare:(fun l r -> Int.compare r.inspections l.inspections);
26 ms.(0).inspections * ms.(1).inspections |> Printer.of_int
27
28let do_monkey2 ms id =
29 let m = ms.(id) in
30 List.iter m.items ~f:(fun score ->
31 let score = (m.op score) % (2 * 3 * 5 * 7 * 11 * 13 * 17 * 19 * 23) in
32 let tom = m.to_monkey ~score in
33 ms.(tom) <- { (ms.(tom)) with items = ms.(tom).items @ [ score ] });
34 ms.(id) <-
35 { m with items = []; inspections = m.inspections + List.length m.items }
36
37let partb ls =
38 let sections = Input.to_sections ls in
39 let ms = Array.of_list_map sections ~f:mk_monkey in
40 for _ = 1 to 10000 do
41 for i = 0 to Array.length ms - 1 do
42 do_monkey2 ms i
43 done
44 done;
45 Array.sort ms ~compare:(fun l r -> Int.compare r.inspections l.inspections);
46 ms.(0).inspections * ms.(1).inspections |> Printer.of_int
Day 12
While lost and alone in the jungle, we decide to maximize exercise.
Writing Djikstra’s algorithm in functional code turns out to be hard for someone who thinks in imperative data structures, so I used a while loop and references to the queue and visited sets.
Or at least, I tried to! My initial solution actually didn’t keep the visited set up to date correctly. The only difference between part a and part b was to populate the initial queue with the whole low ground, instead of just one starting point. It still finished fast enough to submit.
When I fixed up my solution, I decided to use a functional recursive function
and a heap, but an imperative Hashtbl.t of the grid and Hash_set.t of the
visited nodes.
- Part a: 00:30:04, rank 2058
- Part b: 00:54:31, rank 3353
- Commit
1let nabes (x, y) = [ (x + 1, y); (x, y - 1); (x, y + 1); (x - 1, y) ]
2
3module PrioXy = struct
4 module T = struct
5 type t = int * Xy.t [@@deriving compare, sexp]
6 end
7
8 include Comparable.Make (T)
9 module Heap = Heap.Make_from_compare (T)
10end
11
12let solve ls is_start =
13 let grid = Hashtbl.create (module Xy) in
14 let starts, goal =
15 List.foldi ls
16 ~init:([], (0, 0))
17 ~f:(fun y (starts, goal) line ->
18 String.to_list line
19 |> List.foldi ~init:(starts, goal) ~f:(fun x (starts, goal) c ->
20 let starts =
21 is_start c
22 |> Option.value_map ~default:starts ~f:(fun _ ->
23 (x, y) :: starts)
24 in
25 let goal, c =
26 match c with
27 | 'S' -> (goal, 'a')
28 | 'E' -> ((x, y), 'z')
29 | v -> (goal, v)
30 in
31 Hashtbl.set grid ~key:(x, y) ~data:(Char.to_int c);
32 (starts, goal)))
33 in
34 let seen = Hash_set.create (module Xy) in
35 let rec seek q =
36 let q, (s, p) = PrioXy.Heap.take_exn q in
37 if Xy.equal p goal then s
38 else if Hash_set.mem seen p then seek q
39 else (
40 Hash_set.add seen p;
41 let ht = Hashtbl.find_exn grid p in
42 let ns =
43 nabes p
44 |> List.filter_map ~f:(fun n ->
45 Hashtbl.find grid n
46 |> Option.bind ~f:(fun nht ->
47 if nht <= ht + 1 then Some (s + 1, n) else None))
48 in
49 let q = PrioXy.Heap.add_list q ns in
50 seek q)
51 in
52 List.map starts ~f:(fun p -> (0, p))
53 |> PrioXy.Heap.of_list |> seek |> Printer.of_int
54
55let parta ls = solve ls (function 'S' -> Some 'a' | _ -> None)
56let partb ls = solve ls (function 'S' | 'a' -> Some 'a' | _ -> None)
Day 13
The elves are in distress, and bad at communicating.
I was too tired to tackle this one at midnight. The joys of aging.
This was basically a modeling problem. I spent a while thinking about the right
way to model a recursive type, and wound up with a representation that stuck
close to the problem description. I was able to use exhaustive pattern matching
to catch all possible comparisons. I also wrote an extremely confusing bug,
where I forgot to call List.rev on the intermediate list accumulators.
Oops!2
Part b was straightforward: I could use my comparison function in a sort, then search for the two unique elements specified in the problem.
- Part a: 22:13:12, rank 30980
- Part b: 22:17:48, rank 29834
- Commit
1type v = Int of int | List of v list
2
3let maybe_prefix running acc =
4 match running with None -> acc | Some i -> Int i :: acc
5
6let to_charval c = Char.to_int c - 48
7
8let to_rep line =
9 let rec to_v running acc i =
10 if i = String.length line then (List.rev acc, i)
11 else
12 match String.get line i with
13 | ',' -> to_v None (maybe_prefix running acc) (i + 1)
14 | ']' -> (maybe_prefix running acc |> List.rev, i + 1)
15 | '[' ->
16 let subv, j = to_v None [] (i + 1) in
17 to_v None (List subv :: acc) j
18 | c ->
19 let running =
20 match running with
21 | Some v -> (v * 10) + to_charval c
22 | None -> to_charval c
23 in
24 to_v (Some running) acc (i + 1)
25 in
26 let l, _ = to_v None [] 0 in
27 l
28
29let rec cmp left right =
30 let subcmp ltl rtl = function 0 -> cmp ltl rtl | v -> v in
31 match (left, right) with
32 | [], [] -> 0
33 | [], _ -> -1
34 | _, [] -> 1
35 | List ls :: ltl, List rs :: rtl -> cmp ls rs |> subcmp ltl rtl
36 | List ls :: ltl, Int r :: rtl -> cmp ls [ Int r ] |> subcmp ltl rtl
37 | Int l :: ltl, List rs :: rtl -> cmp [ Int l ] rs |> subcmp ltl rtl
38 | Int l :: ltl, Int r :: rtl -> Int.compare l r |> subcmp ltl rtl
39
40let parta ls =
41 Input.to_sections ls
42 |> List.foldi ~init:0 ~f:(fun i sum lines ->
43 let l = List.nth_exn lines 0 |> to_rep in
44 let r = List.nth_exn lines 1 |> to_rep in
45 if cmp l r < 0 then sum + i + 1 else sum)
46 |> Printer.of_int
47
48let partb ls =
49 "[[2]]" :: "[[6]]" :: List.filter ls ~f:(fun l -> String.is_empty l |> not)
50 |> List.map ~f:to_rep |> List.sort ~compare:cmp
51 |> List.foldi ~init:1 ~f:(fun i prod -> function
52 | [ List [ List [ Int 2 ] ] ] | [ List [ List [ Int 6 ] ] ] ->
53 prod * (i + 1)
54 | _ -> prod)
55 |> Printer.of_int
Day 14
The sands of time wait for no one, but we wait for them.
I implemented this one by straightforward simulation. I fixed the rock positions and then repeatedly dropped a single grain of sand. I parameterized the dropper on when to stick a grain to the ground. The simulator itself stopped when the first grain of sand crossed the bottom in part a, and when the last grain of sand reached the top in part b.
Two small mistakes cost me time on part b. I allowed grains of sand to sink into the floor, rather than rest on top of it, due to an off-by-one error when I read the problem. I had another off-by-one error since I didn’t count the very last grain of sand which stopped at (500, 0).
- Part a: 00:20:19, rank 651
- Part b: 00:24:34, rank 654
- Commit
1let rec drop ~stop grid (x, y) =
2 let d = (x, y + 1) and dl = (x - 1, y + 1) and dr = (x + 1, y + 1) in
3 match
4 ( stop (x, y),
5 Hash_set.mem grid d,
6 Hash_set.mem grid dl,
7 Hash_set.mem grid dr )
8 with
9 | true, _, _, _ ->
10 Hash_set.add grid (x, y);
11 (x, y)
12 | _, false, _, _ -> drop ~stop grid d
13 | _, _, false, _ -> drop ~stop grid dl
14 | _, _, _, false -> drop ~stop grid dr
15 | _ ->
16 Hash_set.add grid (x, y);
17 (x, y)
18
19let parta ls =
20 let grid, lowest = mkgrid_with_lowest ls in
21 let rec loop grain =
22 if drop ~stop:(fun (_, y) -> y = lowest) grid (500, 0) |> Xy.y = lowest then
23 grain
24 else loop (grain + 1)
25 in
26 loop 0 |> Printer.of_int
27
28let partb ls =
29 let grid, lowest = mkgrid_with_lowest ls in
30 let rec loop grain =
31 if
32 drop ~stop:(fun (_, y) -> y = lowest + 1) grid (500, 0)
33 |> Xy.equal (500, 0)
34 then grain
35 else loop (grain + 1)
36 in
37 loop 1 |> Printer.of_int
Day 15
Underground sensors and beacons, with Manhattan distance calculation. Sure!
I realized pretty quickly for part 1 that I only had to calculate sensor overlap for a single row. As a result I got my best result on any puzzle by far. Then I promptly fell apart on part b!
I realized that the interesting point would be just outside the edge of a sensor, since otherwise there would have to be more than one possible interesting point. But it was late, and I was tired. I wrote edge walking code incorrectly about three times before landing on a working approach: from each cardinal point, walk along one of the four diagonals.
On the plus side, I learned about Scanf.sscanf which made input parsing way
easier!
I didn’t bother to clean this one up. As a consequence it’s a little too long to paste in its entirety here, but perhaps you’ll find my edge walking code entertaining.
- Part a: 00:13:13, rank 199
- Part b: 01:37:11, rank 2611
- Commit
1module DistXy = struct
2 module T = struct
3 type t = int * Xy.t [@@deriving compare, hash, sexp]
4 end
5
6 include T
7 include Hashable.Make (T)
8end
9
10let partb' max ls =
11 let grid = DistXy.Hash_set.create () in
12 List.iter ls ~f:(fun line ->
13 let xs, ys, xb, yb =
14 Scanf.sscanf line
15 "Sensor at x=%d, y=%d: closest beacon is at x=%d, y=%d"
16 (fun xs ys xb yb -> (xs, ys, xb, yb))
17 in
18 let dist = mandist (xs, ys) (xb, yb) in
19 Hash_set.add grid (dist, (xs, ys)));
20 let x, y =
21 Hash_set.find_map grid ~f:(fun (d, (x, y)) ->
22 (* walk its edges *)
23 let edges =
24 List.concat_map
25 [
26 ((x - d - 1, y), (1, 1));
27 ((x, y + d + 1), (1, -1));
28 ((x + d + 1, y), (-1, -1));
29 ((x, y - d - 1), (-1, 1));
30 ]
31 ~f:(fun ((sx, sy), (dx, dy)) ->
32 List.init d ~f:(fun i -> (sx + (i * dx), sy + (i * dy))))
33 in
34 List.find edges ~f:(fun ((x, y) as e) ->
35 x >= 0 && x <= max && y >= 0 && y <= max
36 && Hash_set.for_all grid ~f:(fun (d, c) -> mandist e c > d)))
37 |> Option.value_exn
38 in
39 (x * 4000000) + y |> Printer.of_int
40
41let partb ls = partb' 4000000 ls
Day 16
Inside an active volcano, we still have time for dynamic programming.
This was brutal for me. I am always bad at the dynamic programming ones. I accomplished part a via memoization and depth-first search.
For part b, I tried for multiple hours to build a memoization solution for two actors, but there were too many states for effective pruning. I went to bed at 3am, and implemented a 1am cutoff from here on out.
The next evening I took my first look at the reddit for this year. I saw that most solutions used the fact that the best case was for two actors to open a disjoint set of valves, which is obvious in retrospect but was very not-obvious to me at the time! This also encouraged a tabular dynamic programming solution rather than a depth-first one, to make it easier to find endpoints when only some of the valves were open.
I also learned about the Floyd-Warshall algorithm for calculating pairwise distances between points in a directed graph.
I used String.Table.t instead of a bitset or other clever approach to track
which valves were open. If I’d found the solution faster I might have neatened
that up for speed.
- Part a: 01:11:26, rank 851
- Part b: 18:27:16, rank 7772
- Commit
The solution here is too long to copy into this post, but here’s how I built the
table for the dynamic programming solution. Note that Set.t is not hashable!
1module DPK = struct
2 module T = struct
3 type t = string * string list [@@deriving compare, hash, sexp]
4 end
5
6 include T
7 include Hashable.Make (T)
8end
9
10let dp = Array.init (total_mins + 1) ~f:(fun _ -> DPK.Table.create ()) in
11Hashtbl.set dp.(0) ~key:("AA", []) ~data:0;
12for i = 0 to total_mins - 1 do
13 Hashtbl.iteri dp.(i) ~f:(fun ~key:(l, on) ~data:cf ->
14 let fr =
15 List.sum (module Int) on ~f:(fun v -> Hashtbl.find_exn flows v)
16 in
17 (* Do nothing *)
18 Hashtbl.update
19 dp.(i + 1)
20 (l, on)
21 ~f:
22 (Option.value_map ~default:(cf + fr) ~f:(fun ef ->
23 Int.max ef (cf + fr)));
24 (* Turn on a new valve *)
25 let onset = String.Set.of_list on in
26 Set.diff valid_valves onset
27 |> Set.iter ~f:(fun v ->
28 let t = Hashtbl.find_exn dists (l, v) + 1 in
29 if t + i > total_mins then ()
30 else
31 let new_on = Set.add onset v |> Set.to_list in
32 let newcf = cf + (fr * t) in
33 Hashtbl.update
34 dp.(t + i)
35 (v, new_on)
36 ~f:
37 (Option.value_map ~default:newcf ~f:(fun ef ->
38 Int.max ef newcf))))
39done;
Day 17
I am the man who arranges the blocks.3
Since I had to declare sleep bankruptcy after day 16, I didn’t tackle this one until the 18th.
Part a was not too bad: I was able to accomplish it with pure simulation. In OCaml, I found it easiest to implement a kind of bookmark into the stack. All rows above the bottom of the current block were in a list ordered bottom-to-top, including the current block itself. All rows below were in a list ordered top-to-bottom.
I thought perhaps part b would adjust the size of the blocks, or work area, or allow rotation, or otherwise muck with the practicalities of Tetris. I was mistaken! We wanted to do a lot of drops.
My first thought was to look for totally covered lines, but I decided against: we’d still have to do a bunch of additions, and I thought that any repeated addition would probably be too slow.4
In the end, I looked for a place where upcoming blocks, instructions, and top of the stack had already been seen. In that case, the cycle would repeat indefinitely and let me use O(1) math to find the top of the stack. Empirically I was able to find the cycle looking at only the top 100 lines (I started with 1000).
- Part a: >24h, rank 16240
- Part b: >24h, rank 11511
- Commit
This simulation is too large to post here. Check out the commit above for more Tetris than you hoped for.
Thoughts
I’ve still been doing the puzzles on the day they come out, but I’ve stopped doing them at midnight. My next post will include the 18th through the 25th. I won’t be able to do the puzzles for the 24th or 25th in under 24 hours, since I’ll be spending time with family. I hope you and yours are all enjoying the season. The days are finally getting longer here in the northern hemisphere!
--Chris
This was not the last time I discovered a faster way to parse input. ↩︎
I also wrote a sequence of char-to-int conversion bugs, which were more obvious. I eventually gave up and hardcoded 48, which is ‘0’ in ASCII. It might be worthwhile to include that as a library function. ↩︎
A benefit of doing this after a full night’s sleep was that I didn’t feel pressured to try my first thought, quickly. ↩︎