use djikstra to get min dist between all valves

now i should be able to rewrite traverse in a way that doesn't suck
This commit is contained in:
ryan 2023-11-22 18:27:42 -08:00
parent 360be1a368
commit 8db68c9baf
3 changed files with 105 additions and 67 deletions

View File

@ -58,7 +58,7 @@ let path_distance grid goal start_nodes =
~set_info ~set_info
~get_info ~get_info
~eq:Vec2.( = ) ~eq:Vec2.( = )
~get_weight:(fun _ -> 1) ~get_weight:(fun _ _ -> 1)
~get_neighbors:(get_neighbors grid) ~get_neighbors:(get_neighbors grid)
~goal ~goal
~start_nodes ~start_nodes

View File

@ -15,84 +15,113 @@ Valve JJ has flow rate=21; tunnel leads to valve II
|} |}
;; ;;
type valve = type room =
{ name : string { name : string
; flow : int ; flow : int
; tunnels : string list ; tunnels : string list
} }
[@@deriving show { with_path = false }] [@@deriving show { with_path = false }]
type valve =
{ flow : int
; valves : (string * int) list
}
[@@deriving show { with_path = false }]
let parse_valves lines = let parse_valves lines =
let valves = Hashtbl.create 100 in let rooms = Hashtbl.create 100 in
lines lines
|> List.iter (fun line -> |> List.iter (fun line ->
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 valves name { name; flow; tunnels } | [ flow ], name :: tunnels -> Hashtbl.add rooms name { name; flow; tunnels }
| _ -> failwith "parse error"); | _ -> failwith "parse error");
let valves =
Hashtbl.to_list rooms
|> List.filter_map (fun (_, { name; flow; tunnels = _ }) ->
if flow > 0 || String.(name = "AA") then Some (name, flow) else None)
in
let distances = Hashtbl.create 100 in
valves valves
|> List.iter (fun (from, _) ->
let dist_of =
Fun.(
Utils.djikstra_hash
~get_weight:(fun _ _ -> 1)
~get_neighbors:(fun room ->
(Option.get_exn_or "sad" @@ Hashtbl.get rooms room).tunnels)
~start_nodes:[ from ]
%> Option.get_exn_or "big sad")
in
valves
|> List.remove_assoc ~eq:String.equal from
|> List.iter (fun (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
valves, get_dist
;; ;;
let get_valve valves name = Option.get_exn_or "poo" @@ Hashtbl.get valves name (* let get_valve valves name = Option.get_exn_or "poo" @@ Hashtbl.get valves name *)
(* I think this algorithm fails for 15.1 example and 15.2 because it can't do (* (\* I think this algorithm fails for 15.1 example and 15.2 because it can't do *)
backtracking. But if I dont filter out visited nodes, it takes forever to (* backtracking. But if I dont filter out visited nodes, it takes forever to *)
run. prob need to find the shortest path between each valve thats worth (* run. prob need to find the shortest path between each valve thats worth *)
opening before doing the traversal. *) (* opening before doing the traversal. *\) *)
let traverse valves = (* let traverse valves = *)
Utils.memo (fun self released current time opened visited -> (* Utils.memo (fun self released current time opened visited -> *)
if time = 0 (* if time = 0 *)
then released, opened (* then released, opened *)
else ( (* else ( *)
let open_current = (* let open_current = *)
if current.flow > 0 && (not @@ List.mem current.name opened) (* if current.flow > 0 && (not @@ List.mem current.name opened) *)
then ( (* then ( *)
let time' = time - 1 in (* let time' = time - 1 in *)
let released' = released + (current.flow * time') in (* let released' = released + (current.flow * time') in *)
[ self released' current time' (current.name :: opened) visited ]) (* [ self released' current time' (current.name :: opened) visited ]) *)
else [] (* else [] *)
in (* in *)
let follow_a_tunnel = (* let follow_a_tunnel = *)
current.tunnels (* current.tunnels *)
|> List.filter (fun tunnel -> not @@ List.mem tunnel visited) (* |> List.filter (fun tunnel -> not @@ List.mem tunnel visited) *)
|> List.map (fun name -> (* |> List.map (fun name -> *)
let current' = get_valve valves name in (* let current' = get_valve valves name in *)
let time' = time - 1 in (* let time' = time - 1 in *)
self released current' time' opened (current.name :: visited)) (* self released current' time' opened (current.name :: visited)) *)
in (* in *)
Option.get_or ~default:(released, opened) (* Option.get_or ~default:(released, opened) *)
@@ List.reduce (* @@ List.reduce *)
(fun ((a, _) as a') ((b, _) as b') -> if a > b then a' else b') (* (fun ((a, _) as a') ((b, _) as b') -> if a > b then a' else b') *)
(open_current @ follow_a_tunnel))) (* (open_current @ follow_a_tunnel))) *)
;; (* ;; *)
let solve_part_1 lines = (* let solve_part_1 lines = *)
let valves = parse_valves lines in (* let valves, distances = parse_valves lines in *)
let start = get_valve valves "AA" in (* let start = get_valve valves "AA" in *)
let released, _ = traverse valves 0 start 30 [] [] in (* let released, _ = traverse valves 0 start 30 [] [] in *)
released (* released *)
;; (* ;; *)
let%expect_test "Day 16.1 example" = (* let%expect_test "Day 16.1 example" = *)
Printf.printf "%i" @@ solve_part_1 @@ example_lines; (* Printf.printf "%i" @@ solve_part_1 @@ example_lines; *)
[%expect {| 1358 |}] (* [%expect {| 1358 |}] *)
;; (* ;; *)
let%expect_test "Day 16.1" = let%expect_test "Day 16.1" =
Printf.printf "%i" @@ solve_part_1 @@ Utils.lines_of_input 16; let _, get_dist = parse_valves example_lines in
[%expect {| 2265 |}] Printf.printf "%i" @@ get_dist "AA" "HH";
[%expect {| 5 |}]
;; ;;
let solve_part_2 lines = (* let solve_part_2 lines = *)
let valves = parse_valves lines in (* let valves = parse_valves lines in *)
let start = get_valve valves "AA" in (* let start = get_valve valves "AA" in *)
let released, opened = traverse valves 0 start 26 [] [] in (* let released, opened = traverse valves 0 start 26 [] [] in *)
let released', _ = traverse valves released start 26 opened [] in (* let released', _ = traverse valves released start 26 opened [] in *)
released' (* released' *)
;; (* ;; *)
let%expect_test "Day 16.2" = (* let%expect_test "Day 16.2" = *)
Printf.printf "%i" @@ solve_part_2 @@ Utils.lines_of_input 16; (* Printf.printf "%i" @@ solve_part_2 @@ Utils.lines_of_input 16; *)
[%expect {| 2353 |}] (* [%expect {| 2353 |}] *)
;; (* ;; *)

View File

@ -54,7 +54,7 @@ let djikstra ~eq ~get_info ~set_info ~get_weight ~get_neighbors ~goal ~start_nod
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 (
let new_dist = c_dist + get_weight neighbor in let new_dist = c_dist + get_weight c_node neighbor in
if new_dist < n_dist then set_info neighbor (new_dist, n_visited); if new_dist < n_dist then set_info neighbor (new_dist, n_visited);
seen := List.add_nodup ~eq neighbor !seen)); seen := List.add_nodup ~eq neighbor !seen));
seen seen
@ -82,10 +82,15 @@ let djikstra ~eq ~get_info ~set_info ~get_weight ~get_neighbors ~goal ~start_nod
| _ -> failwith "start_nodes cannot be empty" | _ -> failwith "start_nodes cannot be empty"
;; ;;
(* not used anywhere so far, but cool as a reference for let djikstra_hash
using locally abstract types! (type k)
*) ?(hash = Hashtbl.hash)
let djikstra_hash (type k) ?(hash = Hashtbl.hash) ?(eq = Stdlib.( = )) slots = ?(eq = Stdlib.( = ))
?(slots = 100)
~get_weight
~get_neighbors
~start_nodes
=
let module Tbl = let module Tbl =
CCHashtbl.Make (struct CCHashtbl.Make (struct
type t = k type t = k
@ -94,10 +99,14 @@ let djikstra_hash (type k) ?(hash = Hashtbl.hash) ?(eq = Stdlib.( = )) slots =
let hash = hash let hash = hash
end) end)
in in
let info_tbl = Tbl.create slots in let table = Tbl.create slots in
let get_info node = Tbl.get_or ~default:(Int.max_int, false) info_tbl node in let get_info node = Tbl.get_or ~default:(Int.max_int, false) table node in
let set_info node info = Tbl.replace info_tbl node info in let set_info node info = Tbl.replace table node info in
djikstra ~eq ~get_info ~set_info let dist_of node = Option.(Tbl.get table node >|= fun (dist, _) -> dist) in
let _ =
djikstra ~eq ~get_info ~set_info ~get_weight ~get_neighbors ~goal:None ~start_nodes
in
dist_of
;; ;;
module Parse = struct module Parse = struct