Files
adventofcode2024/23/main.ml

132 lines
4.3 KiB
OCaml

open Printf;;
let rec list_of_lines in_file =
try
let line = input_line in_file in
line :: list_of_lines(in_file)
with End_of_file ->
close_in in_file;
[]
let encode_computer_id str =
Int.logor (Char.code str.[0]) (Int.shift_left (Char.code str.[1]) 8)
let decode_computer_id id =
[Int.logand id 0xff; Int.shift_right id 8] |> List.map Char.chr |> List.to_seq |> String.of_seq
let computer_id_starts_with char id =
Int.logand id 0xff = Char.code char
let parse_computer_pair str =
(encode_computer_id (String.sub str 0 2), encode_computer_id (String.sub str 3 2))
module IntSet = Set.Make(Int)
let make_graph list_of_edges =
let vertices = Hashtbl.create 512 in
let add_association a b =
match Hashtbl.find_opt vertices a with
| Some set -> Hashtbl.replace vertices a (IntSet.add b set)
| None -> Hashtbl.add vertices a ([b] |> IntSet.of_list) in
List.iter (fun (a, b) -> add_association a b; add_association b a) list_of_edges;
vertices
let get_sets_of_three graph =
graph |> Hashtbl.to_seq
|> Seq.fold_left (fun ret_list (a, b_set) ->
b_set |> IntSet.to_seq
|> Seq.filter (fun b -> b > a)
|> Seq.map (fun b ->
b_set
|> IntSet.to_seq
|> Seq.filter (fun c -> c > b)
|> Seq.filter (fun c -> Hashtbl.find graph b |> IntSet.find_opt c |> Option.is_some)
|> Seq.map (fun c -> (a, b, c))
|> List.of_seq)
|> Seq.fold_left List.append ret_list
) []
let has_computer_starting_with char (a, b, c) =
computer_id_starts_with char a
|| computer_id_starts_with char b
|| computer_id_starts_with char c
let triple_to_list (a, b, c) =
[a; b; c]
let rec compare_prefix lst prefix =
match prefix with
| a :: prefix_tail -> begin
match lst with
| b :: lst_tail ->
let compare = Stdlib.compare b a in
if compare <> 0 then
compare
else
compare_prefix lst_tail prefix_tail
| _ -> -1
end
| _ -> 0
let rec search_ahead_starts_with prefix ordered_lists =
match ordered_lists with
| lst :: tail ->
let compare = compare_prefix lst prefix in
if compare > 0 then
[]
else if compare < 0 then
search_ahead_starts_with prefix tail
else begin
lst :: search_ahead_starts_with prefix tail end
| _ -> []
let rec contains_remaining_combinations lower_cardinality_sets begin_list middle_elem end_list =
match end_list with
| elem :: end_list_tail ->
if search_ahead_starts_with (List.append begin_list end_list) lower_cardinality_sets |> List.is_empty then
false
else
contains_remaining_combinations lower_cardinality_sets (List.append begin_list [middle_elem]) elem end_list_tail
| _ -> true
and merge_fully_connected_sets lower_cardinality_sets acc_sets =
match lower_cardinality_sets with
| lst1 :: tail -> begin
match lst1 with
| elem1 :: lst1_tail ->
let other_lists = search_ahead_starts_with lst1_tail tail in
let new_acc = other_lists |> List.fold_left (fun new_sets other ->
match other with
| elem2 :: other_tail ->
if contains_remaining_combinations lower_cardinality_sets [elem1] elem2 other_tail then begin
(elem1 :: other) :: new_sets
end
else
new_sets
| _ -> raise (Invalid_argument "Need sets of at least 2 cardinality")
) acc_sets in
merge_fully_connected_sets tail new_acc
| _ -> raise (Invalid_argument "Need sets of at least 2 cardinality")
end
| _ -> acc_sets |> List.rev
let rec find_biggest_clique sorted_list_of_lists =
if List.length sorted_list_of_lists = 1 then
List.hd sorted_list_of_lists
else
let bigger_sets = merge_fully_connected_sets sorted_list_of_lists [] in
if List.length bigger_sets = 0 then
List.hd sorted_list_of_lists
else
find_biggest_clique bigger_sets
let () =
let f = open_in "input.txt" in
let computer_pairs = list_of_lines f |> List.map parse_computer_pair in
let graph = make_graph computer_pairs in
let sets = get_sets_of_three graph |> List.sort Stdlib.compare in
let sets_filtered = List.filter (has_computer_starting_with 't') sets in
let result = List.length sets_filtered in
let result_clique = find_biggest_clique (List.map triple_to_list sets) |> List.map decode_computer_id |> List.sort Stdlib.compare in
let result2 = String.concat "," result_clique in
printf "%d\n%s\n" result result2