2024 day 23 some further tidy-ups.

This commit is contained in:
2024-12-23 12:45:43 +00:00
parent c97eb9d1b2
commit 2f30285fe7

View File

@@ -20,37 +20,27 @@ let load_file fname =
|> List.map make_pairs |> List.map make_pairs
|> List.fold_left add_connection StringMap.empty |> List.fold_left add_connection StringMap.empty
let is_three_ring connections a _ candidate = let rec find_second_member acc connections visited a =
StringSet.mem candidate (StringMap.find a connections) let rec impl acc a b = function
| [] -> acc
let rec find_third_member acc connections visited a b candidates = | c :: t -> impl (StringSet.of_list [ a; b; c ] :: acc) a b t
match candidates with in
| [] -> acc function
| h :: t ->
if StringSet.mem h visited then
find_third_member acc connections visited a b t
else if not (is_three_ring connections a b h) then
find_third_member acc connections visited a b t
else
let acc = StringSet.of_list [ a; b; h ] :: acc in
find_third_member acc connections visited a b t
let rec find_second_member acc connections visited a candidates =
match candidates with
| [] -> acc | [] -> acc
| h :: t -> | h :: t ->
if StringSet.mem h visited then if StringSet.mem h visited then
find_second_member acc connections visited a t find_second_member acc connections visited a t
else else
let visited = StringSet.add h visited in let visited = StringSet.add h visited in
let acc = let anh =
find_third_member acc connections visited a h StringSet.inter
(StringSet.to_list (StringMap.find h connections)) (StringMap.find a connections)
(StringMap.find h connections)
in in
let acc = impl acc a h (StringSet.to_list anh) in
find_second_member acc connections visited a t find_second_member acc connections visited a t
let rec find_rings acc visited connections computers = let rec find_rings acc visited connections = function
match computers with
| [] -> acc | [] -> acc
| h :: t -> | h :: t ->
if StringSet.mem h visited then find_rings acc visited connections t if StringSet.mem h visited then find_rings acc visited connections t
@@ -62,38 +52,60 @@ let rec find_rings acc visited connections computers =
in in
find_rings acc visited connections t find_rings acc visited connections t
(** [starts_with_t set] returns true if any member of [set] starts with the
letter ['t']. *)
let starts_with_t set = StringSet.exists (fun x -> x.[0] = 't') set let starts_with_t set = StringSet.exists (fun x -> x.[0] = 't') set
let set_compare a b = compare (StringSet.elements a) (StringSet.elements b)
let part1 connections = let part1 connections =
let computers = StringMap.to_list connections |> List.map fst in StringMap.to_list connections
let rings = |> List.map fst
find_rings [] StringSet.empty connections computers |> find_rings [] StringSet.empty connections
|> List.filter starts_with_t |> List.filter starts_with_t |> List.sort_uniq set_compare |> List.length
in |> string_of_int
string_of_int (List.length rings)
let rec search_candidate max_set connections current candidates = (** [search_candidate max_lst connections current candidates] searches for the
match StringSet.choose_opt candidates with longest star network that contains all the computers in [current] and maybe
| None -> some of the elements of [candidates].
if List.length current > List.length max_set then current else max_set
| Some h -> [max_lst] is the biggest network found so far. [connections] is the map of
computers to direct connections.
The initial call should look something like:
[search_candidate [] connections k (StringSet.to_list (StringMap.find k
connections))] *)
let rec search_candidate max_lst connections current candidates =
match candidates with
| [] -> if List.length current > List.length max_lst then current else max_lst
| h :: t ->
let map = StringMap.find h connections in
let current' = h :: current in let current' = h :: current in
let candidates' = let candidates' = List.filter (Fun.flip StringSet.mem map) candidates in
StringSet.inter candidates (StringMap.find h connections) let max_lst = search_candidate max_lst connections current' candidates' in
in search_candidate max_lst connections current t
let max_set = search_candidate max_set connections current' candidates' in
search_candidate max_set connections current
(StringSet.remove h candidates)
(** [find_max_set connections] returns a list containing the largest number of
computers in a star network (that is for every pair of elements in the list
there is a connection between them).
[connections] is the map of connections keyed by computer with the value
being a set of all direct connections. [connections] must be bi-directional
that is if: [StringSet.mem a (StringMap.find b connections)] then
[StringSet.mem b (StringMap.find a connections)]. Note that
[StringSet.mem a (StringMap.find a connections)] must return [false]. *)
let find_max_set connections = let find_max_set connections =
let rec impl max_set = function let rec impl max_lst = function
| [] -> max_set | [] -> max_lst
| (k, v) :: t -> impl (search_candidate max_set connections [ k ] v) t | (k, v) :: t ->
impl
(search_candidate max_lst connections [ k ] (StringSet.to_list v))
t
in in
impl [] (StringMap.to_list connections) impl [] (StringMap.to_list connections)
let part2 connections = let part2 connections =
let max_set = find_max_set connections in find_max_set connections |> List.sort compare |> String.concat ","
List.sort compare max_set |> String.concat ","
let _ = Aoc.main load_file [ (Fun.id, part1); (Fun.id, part2) ] let _ = Aoc.main load_file [ (Fun.id, part1); (Fun.id, part2) ]