diff --git a/bin/day2406.ml b/bin/day2406.ml index f4ea2e1..fd0c433 100644 --- a/bin/day2406.ml +++ b/bin/day2406.ml @@ -1,6 +1,7 @@ -let find_pos map = +(** [find_start map] returns the location [(x, y)] of the starting position. *) +let find_start map = let rec impl row = - if row >= Array.length map then failwith "find_pos" + if row >= Array.length map then failwith "find_start" else match Array.find_index (fun x -> x = '^') map.(row) with | Some i -> (i, row) @@ -8,40 +9,93 @@ let find_pos map = in impl 0 +(** [read_file fname] reads the input map from [fname]. It returns a + [(map, pos, vel)] tuple, consisting of the obsticle map, initial position, + and initial velocity. *) let read_file fname = let lst = Aoc.strings_of_file fname in let map1 = Array.of_list lst in let map2 = Array.map (fun s -> Array.init (String.length s) (String.get s)) map1 in - let pos = find_pos map2 in + let pos = find_start map2 in (map2, pos, (0, -1)) +(** [is_valid_pos map pos] returns true if the position [pos] is valid for the + map [map]. *) let is_valid_pos map (x, y) = if y < 0 || y >= Array.length map then false else if x < 0 || x >= Array.length map.(y) then false else true -let rec move (map, (x, y), (dx, dy)) = - let () = map.(y).(x) <- 'X' in - let x', y' = (x + dx, y + dy) in - if is_valid_pos map (x', y') && map.(y').(x') = '#' then - move (map, (x, y), (-dy, dx)) - else (map, (x', y'), (dx, dy)) +(** [move map (pos, vel)] moves [pos] one step forward on the [map]. [vel] gives + the movement vector. If the movement will cause an obstacle to be hit then + [vel] is rotated right by 90 degrees and we move in that direction. Returns + the updated [(pos, vel)] pair. *) +let rec move map ((x, y), (dx, dy)) = + if is_valid_pos map (x, y) then + let x', y' = (x + dx, y + dy) in + if is_valid_pos map (x', y') && map.(y').(x') = '#' then + move map ((x, y), (-dy, dx)) + else ((x', y'), (dx, dy)) + else ((x, y), (dx, dy)) + +(** [compare_pos pos pos'] provides a total ordering on the positions [pos] and + [pos']. *) +let compare_pos (x, y) (x', y') = + if y < y' then -1 + else if y > y' then 1 + else if x < x' then -1 + else if x > x' then 1 + else 0 + +(** [walk_map map (pos, vel)] walks around [map] starting at [pos] moving in the + direction [vel]. It returns a list of all positions visited before falling + off one of the sides. *) +let walk_map map (pos, vel) = + let rec impl acc (pos, vel) = + if is_valid_pos map pos then impl (pos :: acc) (move map (pos, vel)) + else acc + in + impl [] (pos, vel) + +(** [has_cycles map (pos, vel)] returns true if walking around [map] starting at + [pos] going in [vel] direction will end up in a never ending cycle.*) +let has_cycles map (pos, vel) = + (* We detect a cycle by walking two 'agents' around the map from the same + starting position. Agent 1 moves 1 step at a time, agent 2 moves 2. If + the agents ever end up on the same square facing the same direction we have + a cycle. This works even if the cycle doesn't start immediately. *) + let rec impl (pos, vel) (pos', vel') = + if not (is_valid_pos map pos) then false + else if not (is_valid_pos map pos') then false + else if pos = pos' && vel = vel' then true + else impl (move map (pos, vel)) (move map (move map (pos', vel'))) + in + (* Start Agent 2 a step ahead of Agent 1 so we don't fail at the start + position. *) + impl (pos, vel) (move map (pos, vel)) + +(** [map_copy map] returns a deep copy of [map]. *) +let map_copy = Array.map Array.copy + +(** [walk_block map (pos, vel) bpos] adds a block to the map [map] at [bpos] and + then sees if walking the map starting with [(pos, vel)] has a cycle. *) +let walk_block map (pos, vel) ((bx, by) as bpos) = + if bpos = pos then false + else + let map' = map_copy map in + map'.(by).(bx) <- '#'; + has_cycles map' (pos, vel) let part1 (map, pos, vel) = - let rec impl (map, pos, vel) = - if is_valid_pos map pos then impl (move (map, pos, vel)) else (map, pos, vel) - in - let _ = impl (map, pos, vel) in - Array.iter - (fun y -> - Array.iter (fun x -> print_char x) y; - print_newline ()) - map; - Array.fold_left - (fun acc y -> - Array.fold_left (fun acc x -> if x = 'X' then acc + 1 else acc) acc y) - 0 map + walk_map map (pos, vel) |> List.sort_uniq compare_pos |> List.length -let _ = Aoc.main read_file [ (string_of_int, part1) ] +let part2 (map, pos, vel) = + let map' = Array.copy map in + walk_map map' (pos, vel) + |> List.sort_uniq compare_pos + |> List.filter (walk_block map' (pos, vel)) + |> List.length + +let _ = Aoc.main read_file [ (string_of_int, part1); (string_of_int, part2) ]