changeset 58:76994fea8568

Day 10 Part 2
author Lewin Bormann <lbo@spheniscida.de>
date Thu, 21 Dec 2023 21:54:47 +0100
parents 4a584287ebec
children dbabaef9b4ad
files 2023/day10.ml 2023/input/10_test2.txt 2023/input/10_test3.txt 2023/input/10_test4.txt 2023/input/10_test5.txt
diffstat 5 files changed, 202 insertions(+), 19 deletions(-) [+]
line wrap: on
line diff
--- a/2023/day10.ml	Wed Dec 20 20:55:26 2023 +0100
+++ b/2023/day10.ml	Thu Dec 21 21:54:47 2023 +0100
@@ -97,23 +97,25 @@
   (* Which positions are reachable from the current pos given the field? *)
   let next_candidates field pos =
     let open Position in
-    let current = get_pipe field pos in
-    (* directions we can go based on the current pipe *)
-    let dir_cands = dir_candidates current in
-    (* neighbors we can transfer to based on the current pipe *)
-    let pos_cands =
-      List.map ~f:(fun dir -> (dir, go field pos dir)) dir_cands
+    let inner current =
+      (* directions we can go based on the current pipe *)
+      let dir_cands = dir_candidates current in
+      (* neighbors we can transfer to based on the current pipe *)
+      let pos_cands =
+        List.map ~f:(fun dir -> (dir, go field pos dir)) dir_cands
+      in
+      (* neighbors that we can transfer to with a fitting pipe section *)
+      let good_neighbor_filter (dir, pos) =
+        if valid_step dir (get_pipe field pos) then Some pos else None
+      in
+      let pos_cands_good = List.filter_map ~f:good_neighbor_filter pos_cands in
+      assert (2 >= List.length pos_cands_good);
+      pos_cands_good
     in
-    (* neighbors that we can transfer to with a fitting pipe section *)
-    let good_neighbor_filter (dir, pos) =
-      if valid_step dir (get_pipe field pos) then Some pos else None
-    in
-    let pos_cands_good = List.filter_map ~f:good_neighbor_filter pos_cands in
-    assert (2 >= List.length pos_cands_good);
-    pos_cands_good
+    match get_pipe field pos with current -> inner current | exception _ -> []
 
   (* Beginning at start, discover the path, then return the path once back at the start. *)
-  let rec traverse field start current path =
+  let rec traverse ?(other = false) field start current path =
     let cands = next_candidates field current in
     let empty_path = List.is_empty path
     and at_start = Position.eq start current in
@@ -125,14 +127,15 @@
           (* start position *)
           assert (0 = Position.compare start current);
           assert (2 = List.length cands);
-          (* start with first candidate, arbitrarily *)
-          let first = List.hd_exn cands in
-          traverse field start first (current :: path)
+          (* start with which candidate? determines direction of traversal *)
+          let ix = if other then 1 else 0 in
+          let first = List.nth_exn cands ix in
+          traverse ~other field start first (current :: path)
       | last :: _lasts ->
           let not_last p = not (0 = Position.compare p last) in
           let nexts = List.filter ~f:not_last cands in
           let next = List.hd_exn nexts in
-          traverse field start next (current :: path)
+          traverse ~other field start next (current :: path)
 
   (* Find start point and traverse path. *)
   let find_path field =
@@ -160,8 +163,150 @@
     to_field parsed_rows
 end
 
+module Part2 = struct
+  (* bitmap for tiles: true if tile is inside of path. *)
+  type t = bool array
+
+  let create field : t = Array.create ~len:(field.rows * field.cols) false
+
+  (* check if position is valid *)
+  let exists field (Position.Position (x, y)) =
+    x < field.rows && y < field.cols && x >= 0 && y >= 0
+
+  (* convert position to index in bitmap *)
+  let pos_to_ix field (Position.Position (x, y)) = (field.cols * x) + y
+  (* convert index (in bitmap) to position *)
+
+  let ix_to_pos field ix =
+    let row = Int.(ix / field.cols) and col = Int.(ix % field.cols) in
+    Position.Position (row, col)
+
+  (* check if pos is marked as inside the field. *)
+  let is_inside field t pos =
+    let ix = pos_to_ix field pos in
+    if ix >= 0 && ix < Array.length t then t.(ix) else false
+
+  (* mark a tile as inside of the path *)
+  let mark_inside field t pos = t.(pos_to_ix field pos) <- true
+
+  (* going from from to top, which direction are we going? *)
+  let direction from top =
+    let open Position in
+    let diff a b = Int.(abs (a - b)) in
+    let (Position (fx, fy)) = from and (Position (tx, ty)) = top in
+    assert (diff fx tx + diff fy ty = 1);
+    match (tx - fx, ty - fy) with
+    | 1, 0 -> S
+    | -1, 0 -> N
+    | 0, 1 -> E
+    | 0, -1 -> W
+    | _ -> assert false
+
+  (* return rel. positions to the left of pipe if we go into it heading direction dir.
+     For example, a horizontal pipe entered from the east going west has its left element
+     in the cell right above it.
+  *)
+  let left_of_pipe pipe dir =
+    match (pipe, dir) with
+    | Vert, N -> [ (0, -1) ]
+    | Vert, S -> [ (0, 1) ]
+    | Vert, _ -> assert false
+    | Horiz, W -> [ (1, 0) ]
+    | Horiz, E -> [ (-1, 0) ]
+    | Horiz, _ -> assert false
+    | NE, S -> [ (-1, 1) ]
+    | NE, W -> [ (1, 0); (1, -1); (0, -1) ]
+    | NE, _ -> assert false
+    | NW, S -> [ (0, 1); (1, 1); (1, 0) ]
+    | NW, E -> [ (-1, -1) ]
+    | NW, _ -> assert false
+    | SE, N -> [ (-1, -1); (0, -1); (-1, 0) ]
+    | SE, W -> [ (1, 1) ]
+    | SE, _ -> assert false
+    | SW, N -> [ (1, -1) ]
+    | SW, E -> [ (-1, 0); (-1, 1); (0, 1) ]
+    | SW, _ -> assert false
+    | Ground, _ -> assert false
+    (* a start field is accessible from all directions *)
+    | Start, d -> (
+        match d with
+        | N -> [ (0, -1) ]
+        | S -> [ (0, 1) ]
+        | E -> [ (-1, 0) ]
+        | W -> [ (1, 0) ])
+
+  (* on the segment from -> to_pos, generate all positions around to_pos
+     that are to the left of it (in the direction of traversal. *)
+  let candidate_positions from to_pos to_pipe =
+    let open Position in
+    let dir = direction from to_pos in
+    let (Position (px, py)) = to_pos in
+    let f (dx, dy) = Position (px + dx, py + dy) in
+    List.map ~f (left_of_pipe to_pipe dir)
+
+  (* for each segment of the path (from -> top), mark all left neighbors.
+     A neighbor is marked if it is not part of the path. The tile type doesn't matter. *)
+  let mark_left_neighbors field t pathset from top =
+    let pipe = get_pipe field top in
+    let cands = candidate_positions from top pipe in
+    let cands = List.filter ~f:(exists field) cands in
+    let maybe_mark pos =
+      if not (Hash_set.mem pathset pos) then mark_inside field t pos else ()
+    in
+    List.iter ~f:maybe_mark cands
+
+  (* mark ground tiles left-adjacent to path. *)
+  let mark_initial field t path pathset =
+    let f current next =
+      mark_left_neighbors field t pathset current next;
+      next
+    in
+    ignore @@ List.fold ~init:(List.hd_exn path) ~f (List.tl_exn path)
+
+  (* return candidate positions neighboring pos. Not all of them are valid, for example they might be part of the path. *)
+  let neighbor_cands pos =
+    let open Position in
+    let (Position (x, y)) = pos in
+    let f (dx, dy) = Position (x + dx, y + dy) in
+    let cands_d = [ (1, 0); (0, 1); (-1, 0); (0, -1) ] in
+    List.map ~f cands_d
+
+  (* mark any neighbors of pos if they are ground.
+     No diagonal neighbors considered.
+     This is basically DFS. *)
+  let rec mark_adjacent_ground field t pathset pos =
+    let neighs = neighbor_cands pos in
+    let ok neigh =
+      (not @@ Hash_set.mem pathset neigh)
+      && (not (is_inside field t neigh))
+      && exists field neigh
+    in
+    let ok_neighs = List.filter ~f:ok neighs in
+    List.iter ~f:(mark_inside field t) ok_neighs;
+    (* recurse into neighbors *)
+    List.iter ~f:(mark_adjacent_ground field t pathset) ok_neighs
+
+  let count_enclosed_tiles field path =
+    let t = create field in
+    let pathset = Hash_set.of_list (module Position) path in
+    mark_initial field t path pathset;
+    let mark ix marked =
+      if marked then mark_adjacent_ground field t pathset (ix_to_pos field ix)
+      else ()
+    in
+    Array.iteri ~f:mark t;
+    Array.count ~f:(fun x -> x) t
+end
+
 let () =
   let input = In_channel.(input_lines stdin) in
   let field = Parse.parse_field input in
   let path = Part1.find_path field in
-  Out_channel.(printf "length: %d\n" (List.length path))
+  let revpath = List.rev path in
+  let in_path1 = Part2.count_enclosed_tiles field revpath in
+  let in_path2 =
+    Part2.count_enclosed_tiles field (List.hd_exn revpath :: path)
+  in
+  Out_channel.(
+    printf "length: %d\n" (List.length path);
+    printf "in path: %d %d\n" in_path1 in_path2)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/2023/input/10_test2.txt	Thu Dec 21 21:54:47 2023 +0100
@@ -0,0 +1,9 @@
+...........
+.S-------7.
+.|F-----7|.
+.||.....||.
+.||.....||.
+.|L-7.F-J|.
+.|..|.|..|.
+.L--J.L--J.
+...........
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/2023/input/10_test3.txt	Thu Dec 21 21:54:47 2023 +0100
@@ -0,0 +1,10 @@
+.F----7F7F7F7F-7....
+.|F--7||||||||FJ....
+.||.FJ||||||||L7....
+FJL7L7LJLJ||LJ.L-7..
+L--J.L7...LJS7F-7L7.
+....F-J..F7FJ|L7L7L7
+....L7.F7||L7|.L7L7|
+.....|FJLJ|FJ|F7|.LJ
+....FJL-7.||.||||...
+....L---J.LJ.LJLJ...
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/2023/input/10_test4.txt	Thu Dec 21 21:54:47 2023 +0100
@@ -0,0 +1,10 @@
+FF7F7F7F7F7F7F7F---7
+L|LJS|||||||||||F--J
+FL-7LJLJ||||||LJL-77
+F--JF--7||LJLJ7F7FJ-
+L---JF-JLJ.||-FJLJJ7
+|F|F-JF---7F7-L7L|7|
+|FFJF7L7F-JF7|JL---7
+7-L-JL7||F7|L7F-7F7|
+L.L7LFJ|||||FJL7||LJ
+L7JLJL-JLJLJL--JLJ.L
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/2023/input/10_test5.txt	Thu Dec 21 21:54:47 2023 +0100
@@ -0,0 +1,9 @@
+..........
+.S------7.
+.|F----7|.
+.||....||.
+.||....||.
+.|L-7F-J|.
+.|..||..|.
+.L--JL--J.
+..........