Mercurial > lbo > hg > aoc22
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