changeset 39:148faba1454d

Day 03 Part 2
author Lewin Bormann <lbo@spheniscida.de>
date Sun, 03 Dec 2023 12:39:11 +0100
parents cce3368a1897
children 4ff5d91ffc8c
files 2023/day03.ml
diffstat 1 files changed, 72 insertions(+), 9 deletions(-) [+]
line wrap: on
line diff
--- a/2023/day03.ml	Sun Dec 03 11:08:02 2023 +0100
+++ b/2023/day03.ml	Sun Dec 03 12:39:11 2023 +0100
@@ -25,7 +25,7 @@
     Hash.get_hash_value h2
 end
 
-let create_position_tbl =
+let create_position_tbl () : (position, 'a) Hashtbl.t =
   let position_hashtbl_key =
     (module PositionKey : Base.Hashtbl.Key.S with type t = position)
   in
@@ -104,15 +104,15 @@
     all_lines
 
   let build_symbol_map all_lines =
-    let posmap = create_position_tbl in
+    let symmap = create_position_tbl () in
     let f = function
       | Symbol { c; position } ->
-          ignore (Hashtbl.add posmap ~key:position ~data:c)
+          ignore (Hashtbl.add symmap ~key:position ~data:c)
       | _ -> ()
     in
     let ff = List.iter ~f in
     List.iter ~f:ff all_lines;
-    posmap
+    symmap
 
   let all_numbers all_lines =
     let f = function Number _ -> true | _ -> false in
@@ -148,11 +148,11 @@
     in
     let upper =
       Sequence.to_list
-        (Sequence.map (count_seq y (y + digits + 1)) ~f:(fun y' -> (x - 1, y')))
+        (Sequence.map (count_seq y (y + digits)) ~f:(fun y' -> (x - 1, y')))
     in
     let lower =
       Sequence.to_list
-        (Sequence.map (count_seq y (y + digits + 1)) ~f:(fun y' -> (x + 1, y')))
+        (Sequence.map (count_seq y (y + digits)) ~f:(fun y' -> (x + 1, y')))
     in
     List.concat [ corners; upper; lower ]
 
@@ -162,12 +162,15 @@
         let ok = Hashtbl.mem symmap { x; y } in
         if ok then ok else check_adjacent_symbol symmap poss
 
+  (* Using a symbol position map, check if a Number item has an adjacent symbol. *)
   let has_adjacent_symbol symmap = function
     | Number { start; digits; _ } ->
         let adjpos = adjacent_positions start digits in
         check_adjacent_symbol symmap adjpos
     | _ -> false
 
+  (* from all parsed lines (item list list), return a flat list of all Number
+     items with adjacent symbol. *)
   let filter_part_numbers all_lines =
     let symmap = build_symbol_map all_lines in
     let all_numbers = all_numbers all_lines in
@@ -176,7 +179,47 @@
     in
     part_numbers
 
-  let debug_part_numbers ch =
+  (* Part 2 naturally depends on part 1: *)
+  module Part2 = struct
+    let build_gear_map all_lines =
+      let symmap : (position, int * int) Hashtbl.t = create_position_tbl () in
+      let f = function
+        | Symbol { c = '*'; position } ->
+            ignore (Hashtbl.add symmap ~key:position ~data:(0, 1))
+        | Number _ | Symbol _ -> ()
+      in
+      let ff = List.iter ~f in
+      List.iter ~f:ff all_lines;
+      symmap
+
+    (* part 2: *)
+    let update_gearmap (gearmap : (position, int * int) Hashtbl.t) = function
+      | Number { start; digits; value } ->
+          let f (x, y) =
+            (* only multiply two numbers *)
+            let current = Hashtbl.find gearmap { x; y } in
+            match current with
+            | Some (count, value') when count < 2 ->
+                Hashtbl.set gearmap ~key:{ x; y }
+                  ~data:(count + 1, value * value')
+            | _ -> ()
+          in
+          let adjpos = adjacent_positions start digits in
+          List.iter ~f adjpos
+      | _ -> ()
+
+    (* part 2: *)
+    let build_gear_table all_lines =
+      let gearmap = build_gear_map all_lines in
+      let all_numbers = all_numbers all_lines in
+      let f n =
+        if has_adjacent_symbol gearmap n then update_gearmap gearmap n else ()
+      in
+      List.iter ~f all_numbers;
+      gearmap
+  end
+
+  let solve_parts_1_2 ch =
     let all_lines = read_lines ch in
     let pns = filter_part_numbers all_lines in
     let sum =
@@ -185,7 +228,27 @@
         pns
     in
     Out_channel.printf "Sum is %d\n" sum;
-    Sexp.to_string_hum (List.sexp_of_t sexp_of_item pns)
+    (* part 2: use already-parsed input *)
+    let geartable = Part2.build_gear_table all_lines in
+    let sexp_of_tuple (pos, (count, value)) =
+      Sexp.List
+        [
+          sexp_of_position pos;
+          Sexp.List [ Int.sexp_of_t count; Int.sexp_of_t value ];
+        ]
+    in
+    let _gears_sexp =
+      Sexp.to_string_hum
+        (List.sexp_of_t sexp_of_tuple (Hashtbl.to_alist geartable))
+    in
+    let htfold ~key ~data:(count, value) acc =
+      ignore key;
+      if Int.equal count 2 then acc + value else acc
+    in
+    let gearratiosum = Hashtbl.fold geartable ~init:0 ~f:htfold in
+    (*Out_channel.printf "Geartable is %s\n" gears_sexp*)
+    Out_channel.printf "Gear ratio sum is %d\n" gearratiosum
+  (*Sexp.to_string_hum (List.sexp_of_t sexp_of_item pns)*)
 end
 
-let () = Out_channel.print_endline (Part1.debug_part_numbers In_channel.stdin)
+let () = Part1.solve_parts_1_2 In_channel.stdin