changeset 78:ade1919a5409 default tip

Day 17: streamline PQ
author Lewin Bormann <lbo@spheniscida.de>
date Tue, 02 Jan 2024 18:42:41 +0100
parents 85797fc052cc
children
files 2023/day17.ml
diffstat 1 files changed, 26 insertions(+), 5 deletions(-) [+]
line wrap: on
line diff
--- a/2023/day17.ml	Sun Dec 31 09:37:40 2023 +0100
+++ b/2023/day17.ml	Tue Jan 02 18:42:41 2024 +0100
@@ -21,7 +21,7 @@
     type t = Elt.t
   end
 
-  type t = (Elt.t, EltComp.comparator_witness) Set.t
+  type t = Set.M(EltComp).t
 
   let empty : t = Set.empty (module EltComp)
   let is_empty = Set.is_empty
@@ -37,6 +37,21 @@
     Sexp.List (List.map elts ~f:Elt.sexp_of_t)
 end
 
+module PQ (Inner : Comparator.S) = struct
+  module T = struct
+    type t = int * Inner.t
+
+    let compare (a, x) (b, y) =
+      match Int.compare a b with 0 -> Inner.comparator.compare x y | x -> x
+
+    let sexp_of_t (a, x) =
+      Sexp.List [ Int.sexp_of_t a; Inner.comparator.sexp_of_t x ]
+  end
+
+  include T
+  include Comparator.Make (T)
+end
+
 module Int_pq = PrioQueue (Int)
 
 let () =
@@ -126,10 +141,16 @@
 
   (* Return potential neighbors at position (r, c) in direction dir *)
   let neighbors r c : direction -> neighbor list = function
-    | North -> [ (r - 1, c, North); (r, c - 1, West); (r, c + 1, East) ]
-    | East -> [ (r - 1, c, North); (r + 1, c, South); (r, c + 1, East) ]
-    | South -> [ (r + 1, c, South); (r, c - 1, West); (r, c + 1, East) ]
-    | West -> [ (r - 1, c, North); (r + 1, c, South); (r, c - 1, West) ]
+    | North -> [ (r, c - 1, West); (r, c + 1, East); (r - 1, c, North) ]
+    | East -> [ (r + 1, c, South); (r, c + 1, East); (r - 1, c, North) ]
+    | South -> [ (r, c - 1, West); (r, c + 1, East); (r + 1, c, South) ]
+    | West -> [ (r + 1, c, South); (r, c - 1, West); (r - 1, c, North) ]
+
+  let straight_neighbor r c = function
+    | North -> (r - 1, c, North)
+    | East -> (r, c + 1, East)
+    | South -> (r + 1, c, South)
+    | West -> (r, c - 1, West)
 
   (* Filter out neighbors that are not valid *)
   let valid_neighbors field Position.{ dir; straight; heatloss; _ } neighbors :