Advent of Code '22 in OCaml, Week 4

Posted: 2022-12-31

The home stretch of Advent of Code ‘22 wrapped it up with a bang. I only managed one midnight showing this week, but I enjoyed the puzzles! Plenty of tricky ones, a Game of Life, and cubes!

Week 3 behind.

Day 18

We’re standing in lava-steamed water, an obvious time for spatial analysis.

For part a we were trying to find cubes whose faces were exposed without an adjacent neighbor. I saw that the input was only 2000ish cubes. It’s not at all bad to throw those into a hash set and check each face to see if its neighbor is also in the set. That’s what I did, and it worked fine.

For part b, we had to exclude faces which didn’t have a direct neighbor, but opened into a fully-enclosed space. I briefly thought about trying to detect that condition, but while looking at the input again I noticed that the bounding cube for the full input was not that big. The smallest value in my input was 0, and the largest was 19. It’s much easier to search for faces visible from outside the cube!

A 22-length cube1 is only ~10k elements. I used BFS starting from (-1, -1, -1), incrementing the counter each time progress was blocked by a face.

  • Part a: 22:17:36, rank 18119
  • Part b: 22:39:26, rank 14319
  • Commit
 1let side_nabes (x, y, z) =
 2  [
 3    (x + 1, y, z);
 4    (x, y + 1, z);
 5    (x, y, z + 1);
 6    (x - 1, y, z);
 7    (x, y - 1, z);
 8    (x, y, z - 1);
 9  ]
10
11let parta ls =
12  let grid = Xyz.Hash_set.create () in
13  List.iter ls ~f:(fun l ->
14      match String.split l ~on:',' |> List.map ~f:Int.of_string with
15      | [ x; y; z ] -> Hash_set.add grid (x, y, z)
16      | _ -> failwith "bad line");
17  Hash_set.sum
18    (module Int)
19    grid
20    ~f:(fun c ->
21      side_nabes c |> List.count ~f:(fun n -> Hash_set.mem grid n |> not))
22  |> Printer.of_int
23
24let partb ls =
25  (* Build `grid` as above, tracking the corners of the bounding rectangular
26     prism in (minx, miny, minz) and (maxx, maxy, maxz) *)
27  let seen = Xyz.Hash_set.create () in
28  let rec explore walls q =
29    match q with
30    | [] -> walls
31    | q ->
32        let walls, newq =
33          List.fold_map q ~init:walls ~f:(fun walls ((x, y, z) as point) ->
34              let outside =
35                x < !minx || y < !miny || z < !minz || x > !maxx || y > !maxy
36                || z > !maxz
37              in
38              match (outside, Hash_set.mem seen point) with
39              | true, _ -> (walls, [])
40              | _, true -> (walls, [])
41              | false, false ->
42                  Hash_set.add seen point;
43                  let walls, nps =
44                    side_nabes point
45                    |> List.fold_map ~init:walls ~f:(fun walls n ->
46                           match Hash_set.mem grid n with
47                           | true -> (walls + 1, None)
48                           | false -> (walls, Some n))
49                  in
50                  (walls, List.filter_opt nps))
51        in
52        explore walls (List.concat newq)
53  in
54  (* Count of walls is surface area *)
55  explore 0 [ (!minx, !miny, !minz) ] |> Printer.of_int

Day 19

We require more minerals.

This one was a doozy. I tried to do it at midnight, with a 1am cutoff. I had a memoized depth-first search approach that would have worked for part a’s 24 steps, but I couldn’t finish it off before bedtime. Shortly after work the next day I was able to get an answer using that method.

At any rate it ran very slowly, and wouldn’t have worked for part b’s 32 steps. I wound up turning to reddit for help before tackling part b.

I took two interesting optimizations from other folks’ solutions. The first was to avoid simulating every minute. Instead, at each minute we calculate the number of geodes we’d have at the last minute with no new robots, and each possible robot we might build with exactly our current set of robots.

The second was to filter paths which could not possibly beat our best-known path. This required an upper bound on the total number of geodes a state could produce. The actual value is what we’re simulating, so this had to be something simper to calculate! The most interesting bound I saw was to count geodes under the assumption that we will produce a new geode robot at each minute through the end, since we can’t do better than that.

  • Part a: 18:57:55, rank 8210
  • Part b: 22:52:11, rank 7716
  • Commit

The full solution is too long to paste here, but I’ll paste the function for generating successor states which include a new robot. Robots, recipes, and resources are all in order of [ ore ; clay ; obsidian ; geodes ]

 1let successors (minute, robots, resources) =
 2  (* Assume we can build at most one robot per round. *)
 3  (* For each recipe... *)
 4  List.filter_mapi recipes ~f:(fun robot_i recipe ->
 5      (* rtc = robot, target, current *)
 6      let rtc_by_resource = Types.zip3_exn robots recipe resources in
 7      let open Option.Let_syntax in
 8      (* Do we need more of that robot? *)
 9      let%bind () =
10        match
11          List.nth_exn robots robot_i < List.nth_exn max_robot robot_i
12        with
13        | true -> return ()
14        | false -> None
15      in
16      (* Can we build that robot in time with the robots we have? *)
17      let%bind time =
18        List.map rtc_by_resource ~f:(fun (robot_ct, target, current) ->
19            time_for_resource target current robot_ct)
20        |> Option.all
21        >>= List.max_elt ~compare:Int.compare
22      in
23      let%map minute =
24        match minute + time < minutes with
25        | true -> Some (minute + time + 1)
26        | false -> None
27      in
28      (* If so, emit a state where we build that robot. *)
29      ( minute,
30        List.mapi robots ~f:(fun i rc ->
31            if i = robot_i then rc + 1 else rc),
32        List.map rtc_by_resource ~f:(fun (robot_ct, target, current) ->
33            current - target + (robot_ct * (time + 1))) ))

It would probably have been better to use arrays here, but since I was already cheating by going to reddit I wanted to stick with a purely functional solution. Even so, I used a hash set to track visited states.

Day 20

Communication issues continue. The only way forward is to play a cup game against a crab reverse engineer the encryption scheme!

We had to shuffle cups numbers around a ring. This was very reminiscent of 2020’s day 23 puzzle, but in this case the numbers could be negative so the structure was a little more complex.

In the old puzzle, each cup had two pieces of relevant information: its value and the value of the next cup. In this puzzle, there were four pieces of information: the original position of the number in the ring, the next number, the prior number, and its value. Otherwise, the puzzle is largely the same. The key element (in this case, the original position in the ring) is the array index, and the rest is the array value.

While we can (and I did) convert all movements into forwards movements with a modulo operation, we still need to know the predecessor number in this version of the puzzle. In 2020’s crab game, we always started from the next position in linked-list order, whereas in 2022’s mixing puzzle we iterated over the original order. Since we don’t arrive at a value from its linked-list predecessor, we don’t have that value on hand in this version of the puzzle.

  • Part a: 22:14:57, rank 13336
  • Part b: 22:16:56, rank 12418
  • Commit
 1let to_array_backed_dll ?(f = Fn.id) ls =
 2  let ct = List.length ls in
 3  Array.of_list_mapi ls ~f:(fun i line ->
 4      ((i - 1) % ct, Int.of_string line |> f, (i + 1) % ct))
 5
 6let chase ~len ~from ~ct ll =
 7    let i = ref from in
 8    let to_mv = ct % len in
 9    for k = 0 to to_mv - 1 do
10      i := Xyz.z ll.(!i)
11    done;
12    !i
13
14let mix ll =
15  let ct = Array.length ll - 1 in
16  for i = 0 to ct do
17    let pi, v, ni = ll.(i) in
18    let ppi, pv, _ = ll.(pi) in
19    let _, nv, nni = ll.(ni) in
20    ll.(pi) <- (ppi, pv, ni);
21    ll.(ni) <- (pi, nv, nni);
22    (* ll.(j) will be our new predecessor for i *)
23    let j = chase ll ~len:ct ~from:pi ~ct:v in
24    let ppi, pv, pni = ll.(j) in
25    let _, nv, nni = ll.(pni) in
26    ll.(j) <- (ppi, pv, i);
27    ll.(i) <- (j, v, pni);
28    ll.(pni) <- (i, nv, nni)
29  done
30
31let result ll =
32  let len = Array.length ll in
33  let zi, _ = Array.findi_exn ll ~f:(fun _ (_, v, _) -> v = 0) in
34  List.fold [ 1000; 1000; 1000 ] ~init:(0, zi) ~f:(fun (acc, i) ct ->
35      let j = chase ll ~from:i ~ct ~len in
36      (acc + Xyz.y ll.(j), j))
37  |> fst
38
39let parta ls =
40  let ll = to_array_backed_dll ls in
41  mix ll;
42  result ll |> Printer.of_int
43
44let partb ls =
45  let ll = to_array_backed_dll ls ~f:(fun v -> v * 811589153) in
46  for _ = 1 to 10 do
47    mix ll
48  done;
49  result ll |> Printer.of_int

Day 21

The monkeys are listening yelling!

The monkeys build a little evaluation tree, conveniently handling order of operations for us. After a spot check to see if I could assume that each monkey’s value was only ever used once, I evaluated the tree recursively for part a.

For part b, I confirmed explicitly that the human was only ever on one side of an equation, and built an equation inverter. I was pretty sure from my spot checks that the human was only used along one path, but I would have been sad if I had built inversion functions under that assumption and instead turned out to need a more fully featured solver. Unfortunately, I made a grave error and messed up exactly one inversion.

I made separate inversion functions for target = humn (op) val and target = val (op) humn. Unfortunately, when copying from the first to the second, I messed up subtraction. t = h - v becomes h = t + v, but t = v - h becomes h = v - t. My bug was writing t - v. Finding it was hard since the operation wasn’t in the sample input. I wound up tracing every inversion in my tree and looking for bad math. Fortunately the first such subtraction was relatively high up.

Ironically I think I made this same category of error in an interview once. It certainly felt familiar while I was fixing it….

  • Part a: 17:29:51, rank 16594
  • Part b: 18:42:14, rank 13873
  • Commit
 1type t = Val of int | Op of string * string * string
 2
 3let t_of_string op =
 4  match String.split op ~on:' ' with
 5  | [ lm; action; rm ] -> Op (lm, action, rm)
 6  | [ v ] -> Val (Int.of_string v)
 7  | _ -> failwithf "bad op %s" op ()
 8
 9let eval_op lv action rv =
10  match action with
11  | "+" -> lv + rv
12  | "-" -> lv - rv
13  | "*" -> lv * rv
14  | "/" -> lv / rv
15  | _ -> failwithf "bad action %s" action ()
16
17let rec eval ms m =
18  match Hashtbl.find_exn ms m with
19  | Val v -> v
20  | Op (lm, action, rm) ->
21      let lv = eval ms lm in
22      let rv = eval ms rm in
23      eval_op lv action rv
24
25let parta ls =
26  let ms = String.Table.create () in
27  List.iter ls ~f:(fun line ->
28      match Input.split_on_string line ~sep:": " with
29      | [ monkey; op ] -> Hashtbl.set ms ~key:monkey ~data:(t_of_string op)
30      | _ -> failwithf "bad line %s" line ());
31  eval ms "root" |> Printer.of_int
32
33let invert_left_f invert action rv =
34  match action with
35  | "+" -> fun target -> invert (target - rv)
36  | "-" -> fun target -> invert (target + rv)
37  | "*" -> fun target -> invert (target / rv)
38  | "/" -> fun target -> invert (target * rv)
39  | _ -> failwith "bad action"
40
41let invert_right_f lv action invert =
42  match action with
43  | "+" -> fun target -> invert (target - lv)
44  | "-" -> fun target -> invert (lv - target)
45  | "*" -> fun target -> invert (target / lv)
46  | "/" -> fun target -> invert (lv / target)
47  | _ -> failwith "bad action"
48
49let rec eval_with_humn ms m =
50  match (m, Hashtbl.find_exn ms m) with
51  | "humn", _ -> `Humn Fn.id
52  | _, Val v -> `Val v
53  | _, Op (l, action, r) -> (
54      let lv = eval_with_humn ms l in
55      let rv = eval_with_humn ms r in
56      match (lv, rv) with
57      | `Humn _, `Humn _ -> failwith "humn on both sides. Too hard."
58      | `Val lv, `Val rv -> `Val (eval_op lv action rv)
59      | `Humn invert, `Val rv -> `Humn (invert_left_f invert action rv)
60      | `Val lv, `Humn invert -> `Humn (invert_right_f lv action invert))
61
62let partb ls =
63  let ms = String.Table.create () in
64  List.iter ls ~f:(fun line ->
65      match Input.split_on_string line ~sep:": " with
66      | [ monkey; op ] -> Hashtbl.set ms ~key:monkey ~data:(t_of_string op)
67      | _ -> failwithf "bad line %s" line ());
68  let l, r =
69    match Hashtbl.find_exn ms "root" with
70    | Op (lm, _, rm) -> (lm, rm)
71    | _ -> failwith "bad root"
72  in
73  let result =
74    match (eval_with_humn ms l, eval_with_humn ms r) with
75    | `Val _, `Val _ | `Humn _, `Humn _ -> failwith "uh oh!"
76    | `Val v, `Humn invert | `Humn invert, `Val v -> invert v
77  in
78  result |> Printer.of_int

Day 22

Time for some light extradimensional travel. Hopefully we’re not traveling through time!

This was a modeling puzzle. For part a, I made a hash table from each point to its four adjacent points rather than rely on math. I was pleased to see this would be useful in part b. In part b we folded our map into a cube, so I also had to track the new facing for traveling to each neighbor as well.

After those interesting parts, though, I very much did not want to fold all possible cubes: there are 11 unfoldings of a cube before considering rotational symmetry, and the best scheme I could think of would be to check all of them to see what shape the input took. Instead, I manually folded the cube for my input and hardcoded those transitions.

  • Part a: 20:46:20, rank 12592
  • Part b: 22:02:49, rank 7050
  • Commit

The manual cube unfolding is way too long to paste, and the map parsing is less interesting than building and following the instructions.

 1let build_instrs is =
 2  let r, acc =
 3    String.fold is ~init:(0, []) ~f:(fun (running, acc) -> function
 4      | 'L' -> (0, `L :: `F running :: acc)
 5      | 'R' -> (0, `R :: `F running :: acc)
 6      | c -> ((running * 10) + (Char.to_int c - Char.to_int '0'), acc))
 7  in
 8  List.rev (`F r :: acc)
 9
10let forwardone grid (pos, facing) =
11  let _, _, nexts = pos in
12  let np, nf = List.nth_exn nexts facing in
13  match Hashtbl.find_exn grid np with
14  | true, _, _ -> (pos, facing)
15  | n -> (n, nf)
16
17let rec forward grid (pos, facing) = function
18  | 0 -> (pos, facing)
19  | ct ->
20      let np, nf = forwardone grid (pos, facing) in
21      forward grid (np, nf) (ct - 1)
22
23let apply_instr grid (pos, facing) = function
24  | `L -> (pos, (facing - 1) % 4)
25  | `R -> (pos, (facing + 1) % 4)
26  | `F ct -> forward grid (pos, facing) ct
27
28let parse_map ls =
29  let sections = Input.to_sections ls in
30  let map = List.hd_exn sections in
31  let map_width =
32    List.fold map ~init:0 ~f:(fun width s -> Int.max width (String.length s))
33  in
34  let grid, startx =
35    List.map map ~f:(fun s ->
36        let len = map_width - String.length s in
37        s ^ String.make len ' ')
38    |> build_grid
39  in
40  let instrs = List.nth_exn sections 1 |> List.hd_exn |> build_instrs in
41  (grid, startx, instrs)
42
43let parta ls =
44  let grid, startxy, instrs = parse_map ls in
45  let start = Hashtbl.find_exn grid startxy in
46  let (_, (col, row), _), facing =
47    List.fold instrs ~init:(start, 0) ~f:(apply_instr grid)
48  in
49  (1000 * (row + 1)) + (4 * (col + 1)) + facing |> Printer.of_int

Day 23

Conway’s Game of Elves.

I decided to tackle this one at midnight, since I’d be with family, not puzzling, on the 24th and 25th. I’m glad I did: this was a nice twist on the classic Game of Life and I have had plenty of experience with Advent of Code Game of Life puzzles. In this case we had to count all neighbors as usual, but we also had to count the neighbors in each cardinal direction. For part a we had to model a specific number of steps, and for part b we had to find the first step with no change.

I’ve found that the easiest way to track a Game of Life is to represent the state as a hash set of locations with live points, and handle each step by generating a new hash set based on the rules.2 That’s what I did in OCaml too, but this one might have been amenable to a purely functional solution using tree maps since there aren’t that many elves in the input.

  • Part a: 00:31:42, rank 433
  • Part b: 00:34:59, rank 397
  • Commit
 1let nnabes (x, y) = [ (x - 1, y - 1); (x, y - 1); (x + 1, y - 1) ]
 2let snabes (x, y) = [ (x - 1, y + 1); (x, y + 1); (x + 1, y + 1) ]
 3let wnabes (x, y) = [ (x - 1, y - 1); (x - 1, y); (x - 1, y + 1) ]
 4let enabes (x, y) = [ (x + 1, y - 1); (x + 1, y); (x + 1, y + 1) ]
 5
 6let mkgrid ls =
 7  let grid = Xy.Hash_set.create () in
 8  List.iteri ls ~f:(fun y line ->
 9      String.iteri line ~f:(fun x c ->
10          match c with
11          | '#' -> Hash_set.add grid (x, y)
12          | '.' -> ()
13          | _ -> failwith "bad line"));
14  grid
15
16let round grid dirs =
17  (* key is proposed position, val is list of source positions *)
18  let proposals = Xy.Table.create () in
19  Hash_set.iter grid ~f:(fun elfpos ->
20      match
21        List.for_all dirs ~f:(fun nf ->
22            List.count (nf elfpos) ~f:(Hash_set.mem grid) = 0)
23      with
24      | true -> Hashtbl.add_exn proposals ~key:elfpos ~data:[ elfpos ]
25      | false ->
26          let p =
27            List.fold_until dirs ~init:None
28              ~finish:(fun _ -> elfpos)
29              ~f:(fun _ nabes ->
30                let ns = nabes elfpos in
31                match List.count ns ~f:(Hash_set.mem grid) with
32                | 0 -> Stop (List.nth_exn ns 1)
33                | _ -> Continue None)
34          in
35          Hashtbl.update proposals p ~f:(function
36            | None -> [ elfpos ]
37            | Some ps -> elfpos :: ps));
38  let newgrid = Xy.Hash_set.create () in
39  Hashtbl.iteri proposals ~f:(fun ~key:target ~data:srcs ->
40      match srcs with
41      | [ _ ] -> Hash_set.add newgrid target
42      | srcs -> List.iter srcs ~f:(Hash_set.add newgrid));
43  let hd, tl = List.split_n dirs 1 in
44  (newgrid, tl @ hd)
45
46let parta ls =
47  let grid = ref (mkgrid ls) in
48  let dirs = ref [ nnabes; snabes; wnabes; enabes ] in
49  for _ = 1 to 10 do
50    let ng, nd = round !grid !dirs in
51    grid := ng;
52    dirs := nd
53  done;
54  let minx, maxx, miny, maxy =
55    Hash_set.fold !grid ~init:(0, 0, 0, 0)
56      ~f:(fun (minx, maxx, miny, maxy) (x, y) ->
57        (Int.min minx x, Int.max maxx x, Int.min miny y, Int.max maxy y))
58  in
59  ((maxx - minx + 1) * (maxy - miny + 1)) - Hash_set.length !grid
60  |> Printer.of_int
61
62let grids_equal a b =
63  Hash_set.for_all a ~f:(Hash_set.mem b)
64  && Hash_set.for_all b ~f:(Hash_set.mem a)
65
66let partb ls =
67  let grid = mkgrid ls in
68  let dirs = [ nnabes; snabes; wnabes; enabes ] in
69  let rec tilnomove i grid dirs =
70    let ng, nd = round grid dirs in
71    if grids_equal grid ng then i else tilnomove (i + 1) ng nd
72  in
73  tilnomove 1 grid dirs |> Printer.of_int

Day 24

We’re trapped in a field of overlapping blizzards.

I came back to do days 24 and 25 on Dec 28.

This was another tricky modeling problem, and I needed reddit’s help again. I used a clever approach which I saw mentioned there: for each position at each minute, we can determine if it’s covered by a blizzard by looking in the four cardinal directions, without modeling all blizzard positions at that minute. That sped up my code dramatically: generating all blizzard locations repeatedly was too slow.

The set of all blizzards is on a width * height cycle, or some factor of that, so I tracked observed states in a hash set of (position, time % (width * height)).

For part b, I had to go change a bunch of code where I had assumed the width and height of the grid based on the target position. After that, it was straightforward to run the same search three times.

  • Part a: >24h, rank 12089
  • Part b: >24h, rank 11890
  • Commit
 1let parse ls =
 2  let grid = Xy.Table.create () in
 3  List.iteri ls ~f:(fun y line ->
 4      String.iteri line ~f:(fun x -> function
 5        | ('<' as d) | ('>' as d) | ('^' as d) | ('v' as d) ->
 6            Hashtbl.add_exn grid ~key:(x - 1, y - 1) ~data:d
 7        | '.' | '#' -> ()
 8        | _ -> failwith "bad char"));
 9  (grid, ((List.hd_exn ls |> String.length) - 3, List.length ls - 2))
10
11module State = struct
12  module T = struct
13    type t = Xy.t * int [@@deriving compare, hash, sexp_of]
14  end
15
16  include T
17  include Hashable.Make_plain (T)
18end
19
20let in_grid (x, y) ~width ~height =
21  Xy.equal (x, y) (0, -1)
22  || Xy.equal (x, y) (width - 1, height)
23  || (x >= 0 && x <= width - 1 && y >= 0 && y < height)
24
25let nabes (x, y) ~width ~height =
26  List.filter
27    [ (x, y); (x - 1, y); (x + 1, y); (x, y - 1); (x, y + 1) ]
28    ~f:(fun p -> in_grid p ~width ~height)
29
30let has_blizzval grid key value =
31  Hashtbl.find grid key
32  |> Option.value_map ~default:false ~f:(fun d -> Char.equal value d)
33
34let for_safe_nabes grid ~width ~height p newm ~f =
35  let ns = nabes p ~width ~height in
36  List.iter ns ~f:(fun (x, y) ->
37      match
38        has_blizzval grid ((x + newm) % width, y) '<'
39        || has_blizzval grid ((x - newm) % width, y) '>'
40        || has_blizzval grid (x, (y + newm) % height) '^'
41        || has_blizzval grid (x, (y - newm) % height) 'v'
42      with
43      | true -> ()
44      | false -> f (x, y))
45
46let minutes_at_exit grid ~start ~exit ~width ~height start_min =
47  let cycle = width * height in
48  let seen = State.Hash_set.create () in
49  let q = Deque.create () in
50  Deque.enqueue_back q (start, start_min);
51  let minute = ref start_min in
52  while Deque.is_empty q |> not do
53    let p, m = Deque.dequeue_front_exn q in
54    let c = m % cycle in
55    match (Hash_set.mem seen (p, c), Xy.equal p exit) with
56    | _, true ->
57        minute := m;
58        Deque.clear q
59    | true, _ -> ()
60    | false, false ->
61        Hash_set.add seen (p, c);
62        for_safe_nabes grid ~width ~height p (m + 1) ~f:(fun p ->
63            Deque.enqueue_back q (p, m + 1))
64  done;
65  !minute
66
67let parta ls =
68  let grid, ((exitx, exity) as exit) = parse ls in
69  let width, height = (exitx + 1, exity) in
70  minutes_at_exit grid ~start:(0, -1) ~exit ~width ~height 0 |> Printer.of_int
71
72let partb ls =
73  let grid, ((exitx, exity) as exit) = parse ls in
74  let width, height = (exitx + 1, exity) in
75  let m2e = minutes_at_exit grid ~start:(0, -1) ~exit ~width ~height 0 in
76  let m2s = minutes_at_exit grid ~start:exit ~exit:(0, -1) ~width ~height m2e in
77  let mb2e = minutes_at_exit grid ~start:(0, -1) ~exit ~width ~height m2s in
78  Printer.of_int mb2e

Day 25

Base 5, as implemented by a software vendor.

Merry Christmas!

I spent a little time thinking about doing the math entirely with the digits as provided. It is possible, but involves multiple possible carry values, which is an annoying way to do math.3

Instead, I did the straightforward thing: I converted the input lines into machine representation, summed them, and then converted it into a list of base 5 digits, then converted that to our balanced representation in the to_snafu function below. That carry logic was definitely an interview question I had once, which I know for sure I did not do well on! At least I learned from my experience.

As usual, part b for Christmas is just to click a button!

  • Part a: >24h, rank 14667
  • Part b: >24h, rank 9036
  • Commit
 1let char_to_int = function
 2  | '2' -> 2
 3  | '1' -> 1
 4  | '0' -> 0
 5  | '-' -> -1
 6  | '=' -> -2
 7  | _ -> failwith "bad char"
 8
 9let int_to_char = function
10  | 2 -> '2'
11  | 1 -> '1'
12  | 0 -> '0'
13  | -1 -> '-'
14  | -2 -> '='
15  | _ -> failwith "bad int"
16
17let parta ls =
18  let sum =
19    List.sum
20      (module Int)
21      ls
22      ~f:(fun line ->
23        String.to_list line |> List.rev
24        |> List.foldi ~init:0 ~f:(fun i sum c ->
25               sum + (Int.pow 5 i * char_to_int c)))
26  in
27  (* Construct the base-5 representation of sum as an int list *)
28  let rec to_b5 acc = function
29    | 0 -> acc
30    | v -> to_b5 ((v % 5) :: acc) (v / 5)
31  in
32  (* reverse the digits so we start with the ones place *)
33  let rep = to_b5 [] sum |> List.rev in
34  (* For each place, if it's 3, 4, or 5, carry one forward and subtract *)
35  let rec to_snafu carry acc n =
36    match (carry, n) with
37    | true, [] -> 1 :: acc
38    | false, [] -> acc
39    | c, hd :: tl -> (
40        (* hd is always between 0 and 5 due to the mod above *)
41        let d = if c then hd + 1 else hd in
42        match d with
43        | d when d <= 2 -> to_snafu false (d :: acc) tl
44        | d when d <= 5 -> to_snafu true ((d - 5) :: acc) tl
45        | _ -> failwith "unexpected digit")
46  in
47  to_snafu false [] rep |> List.map ~f:int_to_char |> String.of_char_list
48  |> Printer.of_string

Thoughts

Thanks for playing along with me this Christmas, and reading to the end of this mammoth post! The puzzles felt a little bit harder than in prior years, but I don’t know if that’s just because I’m using a new language. I didn’t hit the leaderboard on any puzzle this year which disappointed me a little bit. It’s ok though: Advent of Code has definitely grown more popular and my life circumstances have changed. I could only try 16 puzzles at midnight. Overall I think I learned a lot about OCaml in practice and am looking forward to a happy, healthy, productive 2023.

--Chris


  1. To catch the faces on the very edge, you need to search one additional layer beyond each live node. Also, this technically works for every rectangular prism, but I think in the case of my input it was in fact a cube. ↩︎

  2. It’d be unusual for a spot to turn live if it had no adjacent live spots in the prior iteration, since that’d make a huge number of spots turn live at each step. ↩︎

  3. I learned from the easter egg text afterwards that balanced ternary was investigated for early computers. It can carry less often, in exchange for having to carry either a +1 or -1. It also requires fewer digit positions for the same value width (or equivalently, more representable values for the same number of digit positions). ↩︎


Home | Feedback | RSS