Advent of Code '22 in OCaml, Week 2
Posted: 2022-12-10
Advent of Code ‘22 days 4 through 10 had some puzzles I felt good about, and also some other puzzles. I was able to stay up til midnight and try for speed except on day 8.
Just the quick hits, since there are 7 days to cover!
Day 4
The elves try to clean the campsite, but are wasting time on rework.
All around I was happy with how I handled input parsing for this puzzle. I had
to first split on , then split each substring on -. I learned from prior
puzzles to handle invalid inputs in one place, at the end of all splitting.
For part b, I lost almost two minutes trying to modify part a’s fully-covered condition rather than rewrite a basic definition of overlapping intervals.
Finally, I learned about List.count. I had reimplemented it with List.sum at
first, but it’s much neater to skip the first-class module and return a bool in
~f.
- Part a: 00:04:23, rank 981
- Part b: 00:07:39, rank 1397
- Commit
1let line_to_int_pairs line =
2 String.split line ~on:','
3 |> List.map ~f:(fun s -> String.split s ~on:'-' |> List.map ~f:Int.of_string)
4
5let parta ls =
6 List.count ls ~f:(fun line ->
7 match line_to_int_pairs line with
8 | [ [ a; b ]; [ c; d ] ] -> (a <= c && d <= b) || (c <= a && b <= d)
9 | _ -> failwith "a")
10
11let partb ls =
12 List.count ls ~f:(fun line ->
13 match line_to_int_pairs line with
14 | [ [ a; b ]; [ c; d ] ] -> (a <= c && b >= c) || (c <= a && d >= a)
15 | _ -> failwith "a")
Day 5
The elves shuffle crates but won’t communicate with a heavy machine operator. OSHA would not approve.
Input parsing was much more complex today, and IMO is slower and harder in OCaml than in Go. In particular it’s verbose to extract only some of the fields of a split to convert them to ints.
Both the input parsing and part a, where crates were moved one at a time, were
well-suited to for loops, so that’s what I did. Part b, where more than one
crate moved per step, benefitted from List.split_n. That’s how I happened to
have implemented part a, so my part b was relatively faster and I snuck into the
top 1000 again.
- Part a: 00:14:26, rank 1279
- Part b: 00:15:20, rank 941
- Commit
1let buildstacks ls =
2 let width = (List.hd_exn ls |> String.length |> succ) / 4 in
3 let rev = Array.create ~len:width [] in
4 List.iter ls ~f:(fun line ->
5 let carr = String.to_array line in
6 for i = 0 to width - 1 do
7 let c = carr.((i * 4) + 1) in
8 if Char.(c <> ' ') then rev.(i) <- c :: rev.(i) else ()
9 done);
10 Array.map rev ~f:List.rev
11
12let buildinstrs =
13 List.map ~f:(fun line ->
14 match String.split line ~on:' ' with
15 | [ _; ct; _; src; _; dst ] ->
16 (Int.of_string ct, Int.of_string src - 1, Int.of_string dst - 1)
17 | _ -> failwith "bad instruction line")
18
19let preprocess ls =
20 match Input.to_sections ls with
21 | [ stacks; instrs ] -> (buildstacks stacks, buildinstrs instrs)
22 | _ -> failwith "bad input"
23
24let parta ls =
25 let stacks, instrs = preprocess ls in
26 List.iter instrs ~f:(fun (ct, src, dst) ->
27 for _ = 1 to ct do
28 let hd, tl = List.split_n stacks.(src) 1 in
29 stacks.(dst) <- hd @ stacks.(dst);
30 stacks.(src) <- tl
31 done);
32 Array.map stacks ~f:List.hd_exn |> Array.to_list |> String.of_char_list
33
34let partb ls =
35 let stacks, instrs = preprocess ls in
36 List.iter instrs ~f:(fun (ct, src, dst) ->
37 let hd, tl = List.split_n stacks.(src) ct in
38 stacks.(dst) <- hd @ stacks.(dst);
39 stacks.(src) <- tl);
40 Array.map stacks ~f:List.hd_exn |> Array.to_list |> String.of_char_list
Day 6
The elves have unreliable communication devices and we have to fix them. At least they’ve learned that communication is key!
I still took too long on this puzzle writing out explicit matches instead of
using List.take as a default. My first pass at part a looked something like:
1match chars with
2| a :: b :: c :: d :: tl -> Char.Set.of_list [a ; b ; c ; d]
Oops! This is the same mistake I made on day 1.
I also was rushing since it felt attainable to score well on this puzzle. Ironically that cost me. I misread the puzzle and returned the longest prefix excluding the first substring of 4 unique characters, rather than including it. That cost me a minute.
For part b, I had to rewrite my match to a List.take. I also found the first
14-character substring with 4 unique characters, instead of 14 unique
characters. Another minute lost. However, the final OCaml code is really
elegant, so I can’t be too mad about it.
- Part a: 00:07:08, rank 3878
- Part b: 00:08:59, rank 3868
- Commit
1let solve ct line =
2 let rec check seen l =
3 let chars = List.take l ct |> Char.Set.of_list in
4 if Set.length chars = ct then seen + ct
5 else check (seen + 1) (List.tl_exn l)
6 in
7 check 0 line
8
9let parta ls = List.hd_exn ls |> String.to_list |> solve 4
10let partb ls = List.hd_exn ls |> String.to_list |> solve 14
Day 7
The elves learn that systems can surprisingly fragile when they run out of disk space.
I spent some time thinking about how to write a
trie type in OCaml, and decided against.
It’s too complicated to build quickly, and Advent of Code problems tend to work
with hashmaps. There might be one somewhere in Core or Base, but I didn’t go
hunting for it.
I noticed that the question didn’t ask about directory names, just their sizes.
I used a reversed list of the directory path to make it easy to implement cd .., and joined the reversed-order list to make a map key. It was easy enough to
update the size recursively to the root, but I forgot to do that on my first
pass and only counted the leaves, costing a minute. I still snuck in the first
1000 submissions on part a!
For part b, I wasted quite a bit of time on bad math. First, I was off by 100x
due to transcription errors. Then I targeted total_used - 30000000 instead of
total_used - 40000000. As a result I was just outside the top 1000 for part b.
- Part a: 00:21:36, rank 946
- Part b: 00:28:02, rank 1013
- Commit
1let updatemap d m sz =
2 String.concat d
3 |> Map.update m ~f:(function None -> sz | Some ct -> ct + sz)
4
5let rec account_to_tree dir_rev m sz =
6 match dir_rev with
7 | [] -> updatemap [] m sz
8 | _ :: tl as curr ->
9 let m = updatemap curr m sz in
10 account_to_tree tl m sz
11
12let buildtree ls =
13 List.fold ls ~init:([], String.Map.empty)
14 ~f:(fun ((dir_rev, m) as curr) line ->
15 match line with
16 | "$ cd /" -> ([], m)
17 | "$ ls" -> curr
18 | "$ cd .." -> (List.tl_exn dir_rev, m)
19 | l ->
20 if String.is_prefix ~prefix:"dir" l then curr
21 else if String.is_prefix l ~prefix:"$ cd " then
22 let subdir = String.length l - 5 |> String.suffix l in
23 (subdir :: dir_rev, m)
24 else
25 let sz = String.split l ~on:' ' |> List.hd_exn |> Int.of_string in
26 (dir_rev, account_to_tree dir_rev m sz))
27 |> snd
28
29let parta ls =
30 let tree = buildtree ls in
31 Map.fold tree ~init:0 ~f:(fun ~key:_ ~data ct ->
32 if data <= 100000 then ct + data else ct)
33
34let partb ls =
35 let tree = buildtree ls in
36 let to_remove = Map.find_exn tree "" - 40000000 in
37 Map.fold tree ~init:40000000 ~f:(fun ~key:_ ~data sz ->
38 if data >= to_remove && data < sz then data else sz)
Day 8
The elves are extremely picky about treehouses.
A full week of midnight puzzling tired me out, so I went to bed early and
tackled this one the next day. I handled the parts in two different ways. For
part a, it seemed most natural to count visible trees from the outside in. I did
that by building a char list list in the convenient order for view in all four
directions, and collecting Xy.ts for each visible tree.
For part b, we had to count from each tree out. I used imperative loops for
that, and in retrospect I regret it: the code is gross and it was extremely
finicky. I think there was a better approach using List.split_n and List.rev
which would map more nicely to part a as well. I didn’t want to tackle this one
again though, so I left it as it was.
On the plus side, I updated my 2-tuple class to be usable as a Hashtbl.t key,
which will probably be helpful in a puzzle with sparse coordinates later on.
- Part a: 20:04:47, rank 64994
- Part b: 20:44:42, rank 58775
- Commit
1let parta ls =
2 let ls = List.map ls ~f:String.to_list in
3 let views =
4 List.concat
5 [
6 List.concat_mapi ls ~f:(fun y line ->
7 [
8 { line; toxy = (fun x -> (x, y)) };
9 {
10 line = List.rev line;
11 toxy = (fun negx -> (List.length line - negx - 1, y));
12 };
13 ]);
14 List.transpose_exn ls
15 |> List.concat_mapi ~f:(fun x line ->
16 [
17 { line; toxy = (fun y -> (x, y)) };
18 {
19 line = List.rev line;
20 toxy = (fun negy -> (x, List.length line - negy - 1));
21 };
22 ]);
23 ]
24 in
25 List.fold views ~init:Types.Xy.Set.empty ~f:(fun s v ->
26 (* '/' = '0' - 1 *)
27 List.foldi v.line ~init:('/', s) ~f:(fun i (maxht, s) tree ->
28 if Char.(tree > maxht) then (tree, v.toxy i |> Set.add s)
29 else (maxht, s))
30 |> snd)
31 |> Set.length
32
33let partb ls =
34 let tbl = Hashtbl.create (module Types.Xy) in
35 List.iteri ls ~f:(fun y line ->
36 String.to_list line
37 |> List.iteri ~f:(fun x c -> Hashtbl.set tbl ~key:(x, y) ~data:c));
38 let bestscore = ref 0 in
39 let maxx = List.hd_exn ls |> String.length in
40 let maxy = List.length ls in
41 for x = 1 to maxx - 2 do
42 for y = 1 to maxy - 2 do
43 let h = Hashtbl.find_exn tbl (x, y) in
44 let upct = ref 0 in
45 let y2 = ref (y - 1) in
46 while !y2 >= 0 do
47 incr upct;
48 if Char.(Hashtbl.find_exn tbl (x, !y2) < h) then decr y2 else y2 := -1
49 done;
50 let downct = ref 0 in
51 y2 := y + 1;
52 while !y2 < maxy do
53 incr downct;
54 if Char.(Hashtbl.find_exn tbl (x, !y2) < h) then incr y2 else y2 := maxy
55 done;
56 let leftct = ref 0 in
57 let x2 = ref (x - 1) in
58 while !x2 >= 0 do
59 incr leftct;
60 if Char.(Hashtbl.find_exn tbl (!x2, y) < h) then decr x2 else x2 := -1
61 done;
62 let rightct = ref 0 in
63 x2 := x + 1;
64 while !x2 < maxx do
65 incr rightct;
66 if Char.(Hashtbl.find_exn tbl (!x2, y) < h) then incr x2 else x2 := maxx
67 done;
68 bestscore := Int.max !bestscore (!upct * !downct * !leftct * !rightct)
69 done
70 done;
71 !bestscore
Day 9
On a rickety bridge, my life flashes before my eyes. My life mostly involves physics simulations.
For part a, I felt clever for noticing that the tail could only ever stay still
or move to the exact spot where the head used to be. I used that in a
List.fold body:
1List.fold hdmvs
2 ~init:((hd, tl), [])
3 ~f:(fun ((hd, tl), tls) nhd ->
4 if oneaway tl nhd then ((nhd, tl), tl :: tls)
5 else ((nhd, hd), hd :: tls))
For part b, though, the tail might have to follow a head which had moved
diagonally. That was straightforward enough to implement with Int.clamp_exn,
but it took some time.
Also for part b, I noticed that it was easier to pre-generate all the places the head would move, then fold the tail nodes through that list. In my initial pass at part a I had done it all in one big gross fold. The snippet above was just one step in that larger fold function.
- Part a: 00:24:10, rank 2823
- Part b: 00:44:00, rank 2755
- Commit
1let oneaway (x1, y1) (x2, y2) = Int.abs (x1 - x2) <= 1 && Int.abs (y1 - y2) <= 1
2let mv ~times (x1, y1) (dx, dy) = (x1 + (dx * times), y1 + (dy * times))
3let mvtowards (xf, yf) (xt, yt) =
4 ( Int.clamp_exn ~min:(xf - 1) ~max:(xf + 1) xt,
5 Int.clamp_exn ~min:(yf - 1) ~max:(yf + 1) yt )
6
7let tracktl ~len ls =
8 let hdposes = List.folding_map ls ~init:(0, 0) ~f:(fun hd l ->
9 let d, ct =
10 match String.split ~on:' ' l with
11 | [ "U"; ct ] -> ((0, 1), Int.of_string ct)
12 | [ "R"; ct ] -> ((1, 0), Int.of_string ct)
13 | [ "L"; ct ] -> ((-1, 0), Int.of_string ct)
14 | [ "D"; ct ] -> ((0, -1), Int.of_string ct)
15 | _ -> failwith "bad line"
16 in
17 (mv hd d ~times:ct, List.init ct ~f:(fun i -> mv hd d ~times:(i + 1))))
18 |> List.concat in
19 let tlposes = List.init len ~f:(fun _ -> (0, 0)) in
20 List.folding_map hdposes ~init:tlposes ~f:(fun tlposes nh ->
21 let tl, tlposes =
22 List.fold_map tlposes ~init:nh ~f:(fun target p ->
23 if oneaway p target then (p, p)
24 else
25 let newp = mvtowards p target in
26 (newp, newp))
27 in
28 (tlposes, tl))
29 |> Types.Xy.Set.of_list |> Set.length
30
31let parta ls = tracktl ~len:1 ls
32
33let partb ls = tracktl ~len:9 ls
Day 10
The elves experiment with outdated video technology.
For part a I missed that the addition code could “jump” one of the important
cycles. Fortunately for my score, apparently so did many other people. My
solution to this problem was to use List.folding_map and List.concat to
generate a single list of register scores at every cycle. Unfortunately I missed
that we were asked to multiply the register value by the cycle number, costing
me a minute.
For part b, my list generation turned out to be very convenient. I could
List.iteri over the register values and emit # or . as required. I did
waste a little time rewriting the generator to return x-1,x,x+1 rather than
handling that only in the print condition. Nevertheless, I was able to improve
my position a lot, and broke into the top 500 for the first time this year!
- Part a: 00:11:49, rank 1534
- Part b: 00:17:14, rank 443
- Commit
1let reg_at_cycles ls =
2 List.folding_map ls ~init:1 ~f:(fun reg l ->
3 match String.split l ~on:' ' with
4 | [ "noop" ] -> (reg, [ reg ])
5 | [ "addx"; sz ] -> (reg + Int.of_string sz, [ reg; reg ])
6 | _ -> failwith "bad line")
7 |> List.concat
8
9let parta ls =
10 reg_at_cycles ls
11 |> List.foldi ~init:0 ~f:(fun i sum reg ->
12 if (i + 1 - 20) % 40 = 0 then sum + (reg * (i + 1))
13 else sum)
14 |> Int.to_string |> print_endline
15
16let partb ls =
17 reg_at_cycles ls
18 |> List.iteri ~f:(fun i c ->
19 let p = i % 40 in
20 if p = c - 1 || p = c || p = c + 1 then print_string "#"
21 else print_string ".";
22 if (i + 1) % 40 = 0 then print_endline "" else ())
Harness improvements
You might have noticed that my day 10 part a solution ended by printing the integer result. That’s because my runner harness required both parts to return the same type so that it could either not print (for benchmarking) or print (for getting the solution). As a result, I chose to return unit in both parts and had to rewrite a bunch of boilerplate.1
I restructured my
harness
to use a GADT which can print one
of the three values (int, string, or unit) to stdout. As a consequence,
I’ll have to include a Printer.of_int or similar function at the end of each
of my solutions going forward.
1module Printer = struct
2 type t = Int : int -> t | String : string -> t | Unit : t
3
4 let of_int i = Int i
5 let of_string s = String s
6 let of_unit _ = Unit
7
8 let print = function
9 | Int i -> Int.to_string i |> print_endline
10 | String s -> print_endline s
11 | Unit -> ()
12end
--Chris
At the time I didn’t think to return a dummy integer in part b. ↩︎