From 8e1cf3a4e8a4e959dc1feaf6d5fc54f5b271339d Mon Sep 17 00:00:00 2001
From: Acvaxoort <rutiousag@gmail.com>
Date: Mon, 23 Dec 2024 23:45:30 +0100
Subject: [PATCH] d23

---
 23/main.ml | 133 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 133 insertions(+)
 create mode 100644 23/main.ml

diff --git a/23/main.ml b/23/main.ml
new file mode 100644
index 0000000..9147f9e
--- /dev/null
+++ b/23/main.ml
@@ -0,0 +1,133 @@
+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 () = Printexc.record_backtrace true in
+  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
\ No newline at end of file