(* * SPDX-FileCopyrightText: Copyright 2025 Alexandre Jesus * * SPDX-License-Identifier: GPL-3.0-or-later *) let parse ch = let parse_line s = match String.split_on_char ':' s with | [ u; vs ] -> let vs = String.trim vs |> String.split_on_char ' ' |> List.filter (( <> ) "") in (u, vs) | _ -> failwith ("Invalid line: " ^ s) in In_channel.input_lines ch |> List.filter (( <> ) "") |> List.map parse_line |> List.to_seq |> Hashtbl.of_seq let solve ch source target over = (* this assumes the graph is a DAG *) let adj = parse ch in let len = List.length over in let over = List.to_seq over |> Seq.map (fun u -> (u, true)) |> Hashtbl.of_seq in let nodes = adj |> Hashtbl.to_seq |> Seq.flat_map (fun (u, vs) -> List.to_seq (u :: vs)) |> List.of_seq |> List.sort_uniq compare in let rem = List.to_seq nodes |> Seq.map (fun n -> (n, 0)) |> Hashtbl.of_seq in let cntf () = List.to_seq nodes |> Seq.map (fun n -> (n, 0)) |> Hashtbl.of_seq in let cnt = Seq.forever cntf |> Seq.take (len + 1) |> Array.of_seq in let incrrem u = Hashtbl.replace rem u (Hashtbl.find rem u + 1) in let decrrem u = let nc = Hashtbl.find rem u - 1 in Hashtbl.replace rem u nc; nc in let incrcnt i u j v = Hashtbl.replace cnt.(i) u (Hashtbl.find cnt.(i) u + Hashtbl.find cnt.(j) v) in let rec fn q = match q with | [] -> Hashtbl.find cnt.(len) target | u :: q -> ( match Hashtbl.find_opt adj u with | None -> fn q | Some vs -> List.fold_left (fun q v -> (if Hashtbl.mem over v then for i = 1 to len do incrcnt i v (i-1) u; done else for i = 0 to len do incrcnt i v i u; done); if decrrem v = 0 then v :: q else q) q vs |> fn) in Hashtbl.to_seq adj |> Seq.iter (fun (u, vs) -> List.iter (fun v -> incrrem v) vs); let q = Hashtbl.to_seq rem |> Seq.filter_map (fun (u, c) -> if c = 0 then Some u else None) |> List.of_seq in (if Hashtbl.mem over source then Hashtbl.replace cnt.(1) source 1 else Hashtbl.replace cnt.(0) source 1); fn q let part1 ch = solve ch "you" "out" [] |> Printf.printf "%d\n" let part2 ch = solve ch "svr" "out" ["dac"; "fft"] |> Printf.printf "%d\n"