Compare commits

...
14 Commits
Author SHA1 Message Date
ryan 8ec58edd08 solve day 18!
it was kinda ez
2024-02-13 23:03:04 -08:00
ryan 1904239ca7 reorganize day 17 code a bit 2024-01-11 10:48:11 -08:00
ryan 46d49dc3fe add pretty printed tower test in day 17 2024-01-11 10:19:39 -08:00
ryan 950f2860df fix day 12 performance regerssion
caused by a change to Grid.at_e that would eagerly format an exception
string even if the function never throws an exception.
2024-01-08 12:48:55 -08:00
ryan d203c9a520 finish day 17 part 2 2024-01-08 12:36:14 -08:00
ryan 8b54ae782c finish day 17 part 1 2024-01-05 11:33:26 -08:00
ryan 9f1499a1d3 implement day 17 rock falling logic 2024-01-04 00:38:09 -08:00
ryan 490696c63d make Grid.draw more flexible
- printer callback includes Vec2.t in the arguments now
- added optional rev_x and rev_y params
2024-01-03 09:18:57 -08:00
ryan a7c039197b fix .ocamlinit ?? 2024-01-03 09:18:27 -08:00
ryan 94f4badcc4 30x speedup on 16.2 from using bitmasks as a set!! 2023-12-04 23:28:54 -08:00
rmanseau 4e57ad4072 clean up 15.1 implementation a bit 2023-11-27 13:45:32 -08:00
ryan f2f3e497d6 get rid of old day 16 solution 2023-11-23 21:35:32 -08:00
ryan 2a515a5323 day 16.1 down to 1.5 seconds !! 2023-11-23 12:22:17 -08:00
ryan 5c0d7867a4 speed up 16.2 by 10x but its still 10 seconds >:( 2023-11-23 11:17:41 -08:00
12 changed files with 2456 additions and 75 deletions

No files matched your search

+1 -1
View File
@@ -1,2 +1,2 @@
#install_printer Aoc.Vec2.pp;; #install_printer Aoc.Vec2.pp;;
#install_printer Aoc.Vec2.pp_grid;; #install_printer Aoc.Grid.pp;;
+1
View File
@@ -0,0 +1 @@
><<<<>>>><>>><<><<<<>>>><<>>><>>><<<<>>>><<>>>><<<>>>><<<>>>><<<>>><<<<>><>><<<<>>><><<<><><>>>><<<<><<<<>><<<>>>><<>><><>>>><<<>>><<<>>><<>>>><>>>><>><>>><<>><><<<<><>><<<>>>><<<>>><<<>><>><<<>>><<<<>>>><><<<>>><<<>>><<<<><<<<>>><<<<>>><<<>>><<<<>>><<>>><<><<<>><<<>>><<<<><<<<>>><<<><<>>>><<<>><>>><<>>><<<><<<<>>><<><<<<>>>><<>>>><<>>>><<<<>>><><<<<><>><<<>>>><<<<>><>>>><>><>><>><<<>><<<>>>><<<>><<>><<<<><<<<><<>>>><<<<><<<>>><>><<<>>><<<><<<><<<<><<><<<>>><<<<>>>><<<<><<>><<<<>>><>>><<<<><<<>>>><<><>><<<<>><<<<>>>><<<><<<<><<<<>>><<<><<>>><>>><<<<>>><<>><<<<>>><<<><<<>><<<<>>>><<<<><<><<<<>>>><>>>><<<<>>>><<<>>>><<<><<>>><>>><<<<>><<<<>>><><>><<<>>>><<<<>><<<>><<>><<<>>><<<>>>><<<<>>>><<>>>><<>>>><><<<<>><<<<>>>><<<<>>><<<<>><>><<<>>><>>>><><<>><<>>><<<>>>><>>><<>><<<>><>>><>>><><>><>><<<><<<>>>><>><<<><<<>>><<<<><<>>>><<<><<<>>>><>><<<>>>><<<>>>><>>><><>>>><>><<><<<>>>><<>>>><<<>>><<<<>>><<<>><>>>><<<<>>>><>><<>>><<<<>>>><<<<><>>>><<>><<>>>><>><<<<>>>><<<<>><<<>>>><<>><><>><<<<>><<<>>>><<<>>><<>><><<<>>>><<>><>><<>><>><<<<>><<<>>><<<<>>><<>>>><<>>><<<<>>><>><<><<<>><>>><<<>><<<<>>>><<<>>><<>>><<<>>><<<<>>>><<<<>>><<<>>><<>>>><<>>><<<>>><<><<>>>><<>>>><<><<>>><<><<<>>>><<<<><<<<>><<<>>>><>>><<<<>>><<<<>>>><<>><<<<>>>><<<><<<><<>>>><<<>>>><<<>>>><<<>><<>>><>>><<<<>>><<<<>><<<>>><<<>><<<<>>><<<<><<><>>><<<<>>><<<<>>>><>><<<<>><<<<>>>><<<<><<<>>>><>><<<<><<<<>>>><>><<><<<>>><<>>><<<<>><<<><<<><>><<>>>><<<><<<<><<<>>>><<<<>><<>><<<<>>>><><<<><<<>>>><<>>>><<>><<<<>>>><><><<<<><><<>>><<><<>>><>>><<>><><<><<>>>><<<<><<<>>>><<>><><<>>>><<<<><><<<>>>><<>>><<<><<<>>>><>><<<<>>>><>>><<><>>>><>>>><<<><>>><>>>><<<>><<<>>><<<<>>>><<>>>><<<<>>>><<><>><<<<>><<<<>>><<>>><>>>><<><<>>><>>>><<><<><<><><<<>><>><<<<>>><<<>>>><<<><<<<>><>><>>><<<<><<<>>>><<<>>><><<<<>>><<<<><<<<>>>><>><>>><<<><<>><<<><>>><<<<>><><<<<><>><<>><<>><>><<<<><<<>><>>>><<>><<<<>>><><<<>><<>><<>><>>><>>>><<><>><<<<>>><>>><<>>><<>>>><<>><<<<>>><>><<<>>><<<>>><<<<>>>><<<><<<<>><<><<<><<<>>><<><<>><>><>>><<<>>><<>><<>>><<>><<>><>><<<<>>>><<<<>>><<<>>>><<<<>>><<<>><<<>><<<<>>>><<>><<<<><<<<>><<>>><><<><<<<>>>><><>>>><<<<>>>><<<<>>>><<>><<<<>>>><<<><>><<>>>><<>>>><<<<>>>><<<>>><>><<>>>><<<>>>><<<<>>><<<<>><<<<>>>><<>>><<>>>><>>><>>>><><>><<<<>>>><<<>>>><<<>><<>>><<<<>>><>>>><<>>>><<<><>>><><<>>>><<>>>><<<>>>><<<<><<<<>>>><>>>><>><<<>>><<<>>>><<<>><<<>>><>><<>>><<><><<><<>>>><>>><<<<>><><>><>>><<<<><>>><<<>>><<<><<<<>>><<<>><<<>>><<>>><<<<><<<<><>><><<<<>>><<<>><<>><<<>><<<<>><>><>>>><<>>><<<>><<<>><<<<>><><<<<>>><<<>>>><<<<>>><<>><>><<>>><><<>>><<<>>><<<>><<>>>><<<<>><<<<>>>><<<><<><<<<>><<<<>><<<>>>><>><<<><>>>><<>>>><<><<<>>>><<<<>><<<>>>><<>>><>><<<<>>>><<<<>>><>>>><<<<><<><<>><>><>>><<<><<<<><<<<>><<<>>><<<<>><<><<<<>>>><<<>>>><<<>>>><<<<>>><<><<>><<><<<<>>>><<<><<<<>>>><<>>><<<<>><>>>><<<<>><<<>>>><<><<<<>>>><<<>><>>>><><<<>><<<><<<>>><>>>><>>><<<<><<<<>>><<>>><<<>>><<<<><<<<>>>><<>>><<<>><<>>><><<<>>>><<><>>><<>><<<>>>><<<><>><<<>>><<>>>><<<>>>><>><<><>><<>>>><<<>>>><<<<>>>><<<>>><<<>><<<<><<<<>><><<><<<>><>>><<<<>>><<<<>><<<>>><<>><<<<><<<><<<><<<>>><<<<>>><<<<>><<>>><<>><<<<>>>><<>>>><<>>>><<>><>>><>>>><<>>>><<<>>><<<<>>><>>><>>>><<<>><<>>><<>>>><<>>>><<<>>><<>>><<<><<<>><>>>><<<>><>>><<<>>><>>>><>><<>>><<<<>>><<<<>><>>><<<<>>><<<<><<<>>><><>>><<<>>><>><>>>><<>>>><<<>><<>>><<>><<<<>><<<<><>>><<>><<<<>>><<<>>><<>>>><>>>><<<><>>>><<><><>>><<>>>><<<>>>><><>><<<<>><<<>>>><<<<><<<<>>>><<<<>><>>>><<<>>>><<><<>>>><<<<>>>><<<<>>><>><>>>><>>>><>><<>>>><>>>><<>>><<<<>>>><<>>><><<>>>><<>><<<<><<><>>>><<<<>><<><<><<>><<<><<<>><<<<>>><<<<>><<>><>>><<<<>>>><<<<>>>><<<<>>><><<<<><<<<><><<<<><<<<>>>><<<<>>>><><>>><<<<><<<<><<<><><<<<>><><<<><<<<>><>>><><><<<><>>><<><<>><<<>><<<>>>><<<<>>><<>><<<<><>>><>>><<>>>><<<<>>><<<>>>><<<>>>><<<>><<<>><<<<>>><<<<>><>>><<<<><>>>><<<>><>>><<>>><<<<>><<><<<>><>>><<<>><<<<>>><<<>>>><>>><><<<><<<>>>><<>>><<><>>>><>>>><<<<>>><><><>>>><<<<>><<<<>>><<>>><<<><<<>>>><<><<<>><<<>>>><<<<>>>><>>><<<>>><><<<>><<<<>><<<>>>><>><<><><<>><<<>><<<>>><<<<>>>><<<><<<<>><<<<>>>><<<<>>>><<><<<<>>><<<<>><<<<>><<<>><<<<>>><<>>>><<>>><>><<>>>><>>><>>><<<><>>>><<<>>><<<<><<<<>>><<><><>>>><<>>>><<>>>><<<<>>>><<><<><<<>>><<<>>>><<><<<><<>>><<<><<<>>>><<<<>>><<>>>><<>><><<<><<>><<>>><<<<>><>><<<>><<<<>><<<<><<>>><<><<<<>>>><<<>><<<<>><<>>>><>>>><>>><>>>><<<>>><<<>>>><<>>>><>><>><<<>><<<>>><<>>><<<<>>><<<<>>><<>>>><>>><>><<<<>>>><<>>>><<>>>><<<<>>>><>>>><><>>><<>>>><<<<><<>>>><<<<>><<<<>>>><<>><<<<><<<<>>><<<<>><<>>>><<<>>>><<<><>><<<><<>>><<<<>><<<>>><><<<<>><<<<>><>>><<<<>>><<<<>>>><>>>><<>>>><<>>><>>>><<<<>>><<>><<<><<><<<>>>><<<>>>><<<<><<>>><>><<<<><<<>>><>><><<<><<>>>><>>>><>><<>>><<>>>><<>>>><<<<>><<>><><<>>><<>><<>><<>>><>><<<<>>>><<>>>><<<<>>><<>><><<<><>><<<>><>>><>><<>>><><>>><<>>>><<<>>><<<<>>><<<>><<>><<<<>>><<<><<<>><<<<><<>><>><<<<>><<>>>><<<>><<<>>>><<<<>>>><<<<>><<>>><<<>>><<<>>>><<<<>>><<<<>>>><>><<<<>>>><<>>><><<>>>><<<<>>>><<<<>>>><>><<>><<<<><<<<>>><><>>><<<<>>><<><>>>><<<<><<<>>>><>>>><<<>>>><<<>>>><<>>><<>>><<<<><<<>><>>><<<><<<>>><Line truncated
+2025
View File
File diff suppressed because it is too large. Load diff
+2 -1
View File
@@ -37,7 +37,8 @@ let reachable f t =
let get_neighbors grid node_pos = let get_neighbors grid node_pos =
let node = Grid.at_e grid node_pos in let node = Grid.at_e grid node_pos in
Vec2.directions Vec2.directions
|> List.filter_map (fun dir -> |> Iter.of_list
|> Iter.filter_map (fun dir ->
let neighbor_pos = Vec2.(node_pos + dir) in let neighbor_pos = Vec2.(node_pos + dir) in
match Grid.at grid neighbor_pos with match Grid.at grid neighbor_pos with
| Some neighbor when reachable node.char neighbor.char -> Some neighbor_pos | Some neighbor when reachable node.char neighbor.char -> Some neighbor_pos
+1 -1
View File
@@ -9,7 +9,7 @@ type tile =
| Path_L | Path_L
| Path_R | Path_R
let char_of_tile = function let char_of_tile _ = function
| Empty -> '-' | Empty -> '-'
| Rock -> '#' | Rock -> '#'
| Sand -> 'o' | Sand -> 'o'
+6 -10
View File
@@ -101,19 +101,15 @@ let solve_part_1 lines scan_y =
(Iter.map (fun n -> n - scan_y) n_slope_consts) (Iter.map (fun n -> n - scan_y) n_slope_consts)
|> Iter.sort_uniq ~cmp:Int.compare |> Iter.sort_uniq ~cmp:Int.compare
in in
let check x = could_be_beacon sensors false @@ Vec2.of_tuple (x, scan_y) in
let rec count_not_beacons count xs = let rec count_not_beacons count xs =
match xs with match xs with
| x :: next :: rest -> | x :: next :: rest ->
let intersection = (* if there is a region [x+1, next), the value of check
if could_be_beacon sensors false @@ Vec2.of_tuple (x, scan_y) then 0 else 1 is the same for each point within it. intersection points
in must be checked separately from the regions between them *)
(* if there is a region between this intersection and the next, the value let intersection = if check x then 0 else 1 in
of could_be_beacon is the same for each point within it. *) let region = if x + 1 < next && check (x + 1) then 0 else next - (x + 1) in
let region =
if x + 1 < next && (could_be_beacon sensors false @@ Vec2.of_tuple (x + 1, scan_y))
then 0
else next - (x + 1)
in
count_not_beacons (count + intersection + region) (next :: rest) count_not_beacons (count + intersection + region) (next :: rest)
| _ -> count | _ -> count
in in
+81 -52
View File
@@ -15,12 +15,10 @@ Valve JJ has flow rate=21; tunnel leads to valve II
|} |}
;; ;;
type room = type valve =
{ name : string { flow : int
; flow : int ; mask : int
; tunnels : string list
} }
[@@deriving show { with_path = false }]
let parse_valves lines = let parse_valves lines =
let rooms = Hashtbl.create 100 in let rooms = Hashtbl.create 100 in
@@ -29,84 +27,115 @@ let parse_valves lines =
let int_matches = List.map int_of_string Re.(matches (Pcre.regexp {|\d+|}) line) in let int_matches = List.map int_of_string Re.(matches (Pcre.regexp {|\d+|}) line) in
let valve_matches = Re.(matches (Pcre.regexp {|[A-Z]{2}|}) line) in let valve_matches = Re.(matches (Pcre.regexp {|[A-Z]{2}|}) line) in
match int_matches, valve_matches with match int_matches, valve_matches with
| [ flow ], name :: tunnels -> Hashtbl.add rooms name { name; flow; tunnels } | [ flow ], name :: tunnels -> Hashtbl.add rooms name (flow, tunnels)
| _ -> failwith "parse error"); | _ -> failwith "parse error");
let valves = let valves =
Hashtbl.to_list rooms Hashtbl.to_list rooms
|> List.filter_map (fun (_, { name; flow; tunnels = _ }) -> |> List.filter (fun (_, (flow, _)) -> flow > 0)
if flow > 0 then Some (name, flow) else None) |> List.mapi (fun i (name, (flow, _)) ->
let mask = Int.(1 lsl i) in
name, { flow; mask })
in in
let distances = Hashtbl.create 100 in let distances = Hashtbl.create 100 in
valves @ [ "AA", 0 ] valves
|> List.iter (fun (from, _) -> |> List.map (fun (valve, _) -> valve)
|> List.cons "AA"
|> List.iter (fun from ->
let dist_of = let dist_of =
Fun.( Fun.(
Utils.djikstra_hash Utils.djikstra_hash
~get_weight:(fun _ _ -> 1) ~get_weight:(fun _ _ -> 1)
~get_neighbors:(fun room -> ~get_neighbors:(fun room ->
(Option.get_exn_or "sad" @@ Hashtbl.get rooms room).tunnels) match Hashtbl.get rooms room with
| Some (_, tunnels) -> Iter.of_list tunnels
| None -> failwith "sad")
~start_nodes:[ from ] ~start_nodes:[ from ]
()
%> Option.get_exn_or "big sad") %> Option.get_exn_or "big sad")
in in
valves valves
|> List.remove_assoc ~eq:String.equal from |> List.remove_assoc ~eq:String.equal from
|> List.iter (fun (valve, _) -> |> List.iter (fun (valve, _) ->
Hashtbl.replace distances (from, valve) (dist_of valve))); Hashtbl.replace distances (from, valve) (dist_of valve)));
let get_dist f t = Option.get_exn_or "huge sad" @@ Hashtbl.get distances (f, t) in let get_dist f t =
match Hashtbl.get distances (f, t) with
| Some dist -> dist
| None -> failwith @@ Printf.sprintf "cant find distance %s -> %s" f t
in
valves, get_dist valves, get_dist
;; ;;
let traverse get_dist = let traverse
let rec traverse' valves time elephant current = get_dist
let options = (valves : (string * valve) list)
valves ?(current = "AA")
|> List.filter_map (fun (name, flow) -> ?(released = 0)
?(opened = 0)
time
=
let states = Hashtbl.create 1000 in
let rec traverse' current time released opened =
Hashtbl.update
states
~f:(fun _ current ->
match current with
| Some r when r >= released -> Some r
| _ -> Some released)
~k:opened;
valves
|> List.iter (fun (name, { flow; mask }) ->
if Int.(mask land opened) = 0
then (
let dist = get_dist current name in let dist = get_dist current name in
let delta = dist + 1 in let time' = time - (dist + 1) in
let score = flow * (time - delta) in if time' > 0
if score < 0 then (
then None let released' = released + (flow * time') in
else ( let opened' = Int.(mask lor opened) in
let valves' = List.remove_assoc ~eq:String.equal name valves in traverse' name time' released' opened')))
Some (score + traverse' valves' (time - delta) elephant name)))
in
(options @ if elephant then [ traverse' valves 26 false "AA" ] else [ 0 ])
|> List.reduce Int.max
|> Option.get_or ~default:0
in in
traverse' traverse' current time released opened;
states
|> Iter.of_hashtbl
|> Iter.sort ~cmp:(fun (_, a_score) (_, b_score) -> b_score - a_score)
;; ;;
let%expect_test "example" = let solve_part_1 lines =
let valves, get_dist = parse_valves example_lines in let valves, get_dist = parse_valves lines in
Printf.printf "part 1: %i\n" @@ traverse get_dist valves 30 false "AA"; let states = traverse get_dist valves 30 in
Printf.printf "part 2: %i\n" @@ traverse get_dist valves 26 true "AA"; match states |> Iter.take 1 |> Iter.to_list with
[%expect {| | [ (_, score) ] -> score
part 1: 1651 | _ -> failwith "no traversals ?"
part 2: 1707 |}]
;; ;;
let%expect_test "Day 16.1 example" = let%expect_test "Day 16.1 example" =
let valves, get_dist = parse_valves example_lines in Printf.printf "%i\n" @@ solve_part_1 example_lines;
Printf.printf "%i\n" @@ traverse get_dist valves 30 false "AA";
[%expect {| 1651 |}] [%expect {| 1651 |}]
;; ;;
let%expect_test "Day 16.2 example" =
let valves, get_dist = parse_valves example_lines in
Printf.printf "%i\n" @@ traverse get_dist valves 26 true "AA";
[%expect {| 1707 |}]
;;
let%expect_test "Day 16.1" = let%expect_test "Day 16.1" =
let valves, get_dist = parse_valves @@ Utils.lines_of_input 16 in Printf.printf "%i\n" @@ solve_part_1 @@ Utils.lines_of_input 16;
Printf.printf "%i\n" @@ traverse get_dist valves 30 false "AA";
[%expect {| 2265 |}] [%expect {| 2265 |}]
;; ;;
(* took 106.465 sec >:( *) let solve_part_2 lines =
(* let%expect_test "Day 16.2" = *) let valves, get_dist = parse_valves @@ lines in
(* let valves, get_dist = parse_valves @@ Utils.lines_of_input 16 in *) let states = traverse get_dist valves 26 in
(* Printf.printf "%i\n" @@ traverse get_dist valves 26 true "AA"; *) states
(* [%expect {| 2811 |}] *) |> Iter.filter_map (fun (a_set, a_score) ->
(* ;; *) match Iter.find_pred (fun (b_set, _) -> Int.(a_set land b_set) = 0) states with
| Some (_, b_score) -> Some (a_score + b_score)
| None -> None)
|> Iter.fold Int.max 0
;;
let%expect_test "Day 16.2 example" =
Printf.printf "%i\n" @@ solve_part_2 example_lines;
[%expect {| 1707 |}]
;;
(* god damn bitmasks are fast, 30x speedup from StrSet! down to 50ms now *)
let%expect_test "Day 16.2" =
Printf.printf "%i\n" @@ solve_part_2 @@ Utils.lines_of_input 16;
[%expect {| 2811 |}]
;;
+201
View File
@@ -0,0 +1,201 @@
open Containers
let cave_width = 7
let example_lines = [ ">>><<><>><<<>><>>><<<>>><<<><<<>><>><<>>" ]
let dir_of_char = function
| '<' -> Vec2.left
| '>' -> Vec2.right
| _ -> failwith "oof"
;;
let next_stream_idx stream idx = (idx + 1) mod Array.length stream
(*[{
#
# # #
### # # ##
#### # ### # ##
row plus angle col square
}]*)
type shape =
| Row
| Plus
| Angle
| Col
| Square
let get_shape idx = [| Row; Plus; Angle; Col; Square |].(idx mod 5)
let shape_points shape pos =
let points =
match shape with
| Row -> [ 0, 0; 1, 0; 2, 0; 3, 0 ]
| Plus -> [ 0, 1; 1, 0; 1, 1; 1, 2; 2, 1 ]
| Angle -> [ 0, 0; 1, 0; 2, 0; 2, 1; 2, 2 ]
| Col -> [ 0, 0; 0, 1; 0, 2; 0, 3 ]
| Square -> [ 0, 0; 1, 0; 0, 1; 1, 1 ]
in
points |> List.map (fun point -> Vec2.(pos + of_tuple point))
;;
type loop_key =
{ rock : shape
; stream_idx : int
; normalized_topo : int array
}
type loop =
{ rock_idx : int
; height : int
}
type cave =
{ grid : char Grid.t
; mutable grid_topo : int array
; mutable grid_height : int
; total_rocks : int
; mutable rocks : int
; mutable stream_idx : int
; loop_cache : (loop_key, loop) Hashtbl.t
; mutable height : int
}
let init_cave max_height total_rocks =
let grid = Grid.init ~width:7 ~height:max_height (Fun.const '.') in
{ grid
; height = -1
; grid_height = -1
; rocks = 0
; stream_idx = 0
; grid_topo = Array.init cave_width (Fun.const 0)
; loop_cache = Hashtbl.create max_height
; total_rocks
}
;;
let draw_cave cave = Grid.draw cave.grid ~rev_y:true (fun _ contents -> contents)
let place_shape cave shape pos =
shape_points shape pos
|> List.iter (fun point ->
let delta = point.Vec2.y - cave.grid_height in
if delta > 0
then (
cave.height <- cave.height + delta;
cave.grid_height <- cave.grid_height + delta);
cave.grid_topo.(point.x) <- max point.y cave.grid_topo.(point.x);
Grid.set_e cave.grid point '#')
;;
let can_place_shape cave shape pos =
shape_points shape pos
|> List.fold_while
(fun _ point ->
match cave.grid.Grid.%(point) with
| Some '.' -> true, `Continue
| _ -> false, `Stop)
false
;;
let drop_shape cave stream =
let shape = get_shape cave.rocks in
let rec drop pos =
let stream_pos = Vec2.(pos + stream.(cave.stream_idx)) in
cave.stream_idx <- next_stream_idx stream cave.stream_idx;
let pos = if can_place_shape cave shape stream_pos then stream_pos else pos in
let drop_pos = Vec2.(pos + Vec2.up) in
if can_place_shape cave shape drop_pos
then drop drop_pos
else place_shape cave shape pos
in
cave.rocks <- cave.rocks + 1;
drop Vec2.{ x = 2; y = Int.(cave.grid_height + 4) }
;;
let normalize_topo topo =
let min = Array.min_exn Int.compare topo in
Array.map (fun x -> x - min) topo
;;
let rec drop_shapes cave stream =
let loop_key =
{ rock = get_shape cave.rocks
; stream_idx = cave.stream_idx
; normalized_topo = normalize_topo cave.grid_topo
}
in
let remaining_rocks cave = cave.total_rocks - cave.rocks in
let loop_rocks loop = cave.rocks - loop.rock_idx in
let loop_fits loop = loop_rocks loop < remaining_rocks cave in
match Hashtbl.get cave.loop_cache loop_key with
| Some loop when loop_fits loop ->
let loop_height = cave.height - loop.height in
cave.height <- cave.height + loop_height;
cave.rocks <- cave.rocks + loop_rocks loop;
drop_shapes cave stream
| _ when remaining_rocks cave > 0 ->
let loop = { height = cave.height; rock_idx = cave.rocks } in
Hashtbl.add cave.loop_cache loop_key loop;
drop_shape cave stream;
drop_shapes cave stream
| _ -> ()
;;
let solve remaining_rocks lines =
let stream = lines |> List.hd |> Iter.of_str |> Iter.map dir_of_char |> Iter.to_array in
let cave = init_cave 100_000 remaining_rocks in
drop_shapes cave stream;
cave.height + 1
;;
let%expect_test "Day 17.1 Example" =
Printf.printf "height: %i\n" @@ solve 2022 example_lines;
[%expect {| height: 3068 |}]
;;
let%expect_test "Day 17.1" =
Printf.printf "height: %i\n" @@ solve 2022 (Utils.lines_of_input 17);
[%expect {| height: 3227 |}]
;;
let%expect_test "Day 17.2 Example" =
Printf.printf "height: %i\n" @@ solve 1_000_000_000_000 example_lines;
[%expect {| height: 1514285714288 |}]
;;
let%expect_test "Day 17.2" =
Printf.printf "height: %i\n" @@ solve 1_000_000_000_000 (Utils.lines_of_input 17);
[%expect {| height: 1597714285698 |}]
;;
let%expect_test "Smol tower" =
let stream =
example_lines |> List.hd |> Iter.of_str |> Iter.map dir_of_char |> Iter.to_array
in
let cave = init_cave 18 8 in
drop_shapes cave stream;
Printf.printf "%s" @@ draw_cave cave;
[%expect
{|
.......
.......
.......
.....#.
.....#.
..####.
.###...
..#....
.####..
....##.
....##.
....#..
..#.#..
..#.#..
#####..
..###..
...#...
..####. |}]
;;
+121
View File
@@ -0,0 +1,121 @@
open Containers
let example_lines =
String.lines
{|2,2,2
1,2,2
3,2,2
2,1,2
2,3,2
2,2,1
2,2,3
2,2,4
2,2,6
1,2,5
3,2,5
2,1,5
2,3,5|}
;;
module Vec3 = struct
type t = int * int * int [@@deriving show, eq, ord, hash]
let directions = [ 1, 0, 0; -1, 0, 0; 0, 1, 0; 0, -1, 0; 0, 0, 1; 0, 0, -1 ]
let ( + ) (x1, y1, z1) (x2, y2, z2) = x1 + x2, y1 + y2, z1 + z2
let ( - ) (x1, y1, z1) (x2, y2, z2) = x1 - x2, y1 - y2, z1 - z2
let ( = ) = equal
let iter_region (ax, ay, az) (bx, by, bz) callback =
for z = az to bz do
for y = ay to by do
for x = ax to bx do
let p = x, y, z in
callback p
done
done
done
;;
let in_bounds (lx, ly, lz) (hx, hy, hz) (x, y, z) =
not (x < lx || x > hx || y < ly || y > hy || z < lz || z > hz)
;;
let find_bounds points =
let first = Iter.head_exn points in
let padding = 1, 1, 1 in
let min, max =
points
|> Iter.drop 1
|> Iter.fold
(fun ((lx, ly, lz), (hx, hy, hz)) (x, y, z) ->
(min lx x, min ly y, min lz z), (max hx x, max hy y, max hz z))
(first, first)
in
min - padding, max + padding
;;
end
module Vec3Set = Set.Make (Vec3)
let parse_points lines =
lines
|> List.map (fun line ->
match List.map Int.of_string_exn Re.(matches (Pcre.regexp {|\d+|}) line) with
| [ x; y; z ] -> x, y, z
| _ -> failwith "oopzi doopers")
|> Vec3Set.of_list
;;
let solve_part_1 lines =
let points = parse_points lines in
let min, max = Vec3.find_bounds @@ Vec3Set.to_iter points in
let surface_area = ref 0 in
Vec3.iter_region min max (fun point ->
if not @@ Vec3Set.mem point points
then
Vec3.directions
|> List.iter (fun dir ->
let n = Vec3.(point + dir) in
if Vec3Set.mem n points then incr surface_area));
!surface_area
;;
let%expect_test "Day 18.1 example" =
Format.printf "%i" @@ solve_part_1 example_lines;
[%expect {| 64 |}]
;;
let%expect_test "Day 18.1" =
Format.printf "%i" @@ solve_part_1 @@ Utils.lines_of_input 18;
[%expect {| 3662 |}]
;;
let solve_part_2 lines =
let points = parse_points lines in
let min, max = Vec3.find_bounds @@ Vec3Set.to_iter points in
let in_bounds = Vec3.in_bounds min max in
let surface_area = ref 0 in
let directions_iter = Iter.of_list Vec3.directions in
let get_neighbors point =
directions_iter
|> Iter.map Vec3.(fun dir -> point + dir)
|> Iter.filter (fun neighbor ->
let in_droplet = Vec3Set.mem neighbor points in
if in_droplet then incr surface_area;
(not in_droplet) && in_bounds neighbor)
in
let _ignore =
Utils.djikstra_hash ~get_weight:(fun _ _ -> 1) ~get_neighbors ~start_nodes:[ min ] ()
in
!surface_area
;;
let%expect_test "Day 18.2 example" =
Format.printf "%i" @@ solve_part_2 example_lines;
[%expect {| 58 |}]
;;
let%expect_test "Day 18.2" =
Format.printf "%i" @@ solve_part_2 @@ Utils.lines_of_input 18;
[%expect {| 2060 |}]
;;
+14 -8
View File
@@ -27,13 +27,15 @@ let at grid point =
;; ;;
let at_e (grid : 'a t) (point : Vec2.t) = let at_e (grid : 'a t) (point : Vec2.t) =
Option.get_exn_or "point out of bounds!" @@ at grid point match at grid point with
| Some point -> point
| None -> failwith @@ Format.sprintf "point %a out of bounds!" Vec2.pp point
;; ;;
let set_e grid point item = let set_e grid point item =
if in_bounds grid point if in_bounds grid point
then Array.set grid.items (idx_of_vec2 grid.width point) item then Array.set grid.items (idx_of_vec2 grid.width point) item
else failwith "point out of bounds!" else failwith (Format.sprintf "point %a out of bounds!" Vec2.pp point)
;; ;;
let ( .%() ) = at let ( .%() ) = at
@@ -82,12 +84,16 @@ let iter grid callback =
iter_region grid a b callback iter_region grid a b callback
;; ;;
let draw grid printer = let draw grid ?(rev_y = false) ?(rev_x = false) printer =
let str = ref [] in let line = ref [] in
let lines = ref [] in
iter grid (fun point -> iter grid (fun point ->
let item = grid.%(point) in let item = grid.%(point) in
let char = printer @@ Option.get_exn_or "iter is broken" item in let char = printer point (Option.get_exn_or "iter is broken" item) in
str := !str @ [ char ]; line := if rev_x then char :: !line else !line @ [ char ];
if point.x = grid.width - 1 then str := !str @ [ '\n' ]); if List.length !line = grid.width
String.of_list !str then (
lines := !lines @ [ String.of_list !line ];
line := []));
String.concat "\n" (if rev_y then List.rev !lines else !lines)
;; ;;
+1 -1
View File
@@ -11,4 +11,4 @@ val find : 'a t -> ('a -> bool) -> (Vec2.t * 'a) option
val count : 'a t -> ('a -> bool) -> int val count : 'a t -> ('a -> bool) -> int
val iter_region : 'a t -> Vec2.t -> Vec2.t -> (Vec2.t -> unit) -> unit val iter_region : 'a t -> Vec2.t -> Vec2.t -> (Vec2.t -> unit) -> unit
val iter : 'a t -> (Vec2.t -> unit) -> unit val iter : 'a t -> (Vec2.t -> unit) -> unit
val draw : 'a t -> ('a -> char) -> string val draw : 'a t -> ?rev_y:bool -> ?rev_x:bool -> (Vec2.t -> 'a -> char) -> string
+2 -1
View File
@@ -50,7 +50,7 @@ let djikstra ~eq ~get_info ~set_info ~get_weight ~get_neighbors ~goal ~start_nod
let c_dist, _ = get_info c_node in let c_dist, _ = get_info c_node in
set_info c_node (c_dist, true); set_info c_node (c_dist, true);
get_neighbors c_node get_neighbors c_node
|> List.iter (fun neighbor -> |> Iter.iter (fun neighbor ->
let n_dist, n_visited = get_info neighbor in let n_dist, n_visited = get_info neighbor in
if not n_visited if not n_visited
then ( then (
@@ -90,6 +90,7 @@ let djikstra_hash
~get_weight ~get_weight
~get_neighbors ~get_neighbors
~start_nodes ~start_nodes
()
= =
let module Tbl = let module Tbl =
CCHashtbl.Make (struct CCHashtbl.Make (struct