(**************************************************************************)
(*                                                                        *)
(*  Thibaut Balabonski, Sylvain Conchon, Jean-Christophe Filliâtre,       *)
(*  Kim Nguyen, Laurent Sartre                                            *)
(*                                                                        *)
(*  Informatique - MP2I/MPI - CPGE 1re et 2e années.                      *)
(*  Cours et exercices corrigés. Éditions Ellipses, 2022.                 *)
(*                                                                        *)
(*  https://www.informatique-mpi.fr/                                      *)
(*                                                                        *)
(**************************************************************************)

(* Graphes orientés, par listes d'adjacence *)

type digraph = int list array

let create (n: int) : digraph =
  Array.make n []

let size (g: digraph) : int =
  Array.length g

let has_edge (g: digraph) (u: int) (v: int) : bool =
  List.mem v g.(u)

let add_edge (g: digraph) (u: int) (v: int) : unit =
  if not (has_edge g u v) then
    g.(u) <- v :: g.(u)

let succ (g: digraph) (u: int) : int list =
  g.(u)

type edge = int * int

let edges (g: digraph) : (int * int) list =
  let l = ref [] in
  for i = 0 to size g - 1 do
    List.iter (fun j -> l := (i, j) :: !l) g.(i)
  done;
  !l

let mirror g =
  let m = create (size g) in
  for i = 0 to size g - 1 do
    List.iter (fun j -> add_edge m j i) g.(i)
  done;
  m

let dfs (g: digraph) (source: int) : bool array =
  let visited = Array.make (size g) false in
  let rec dfs v =
    if not visited.(v) then (
      visited.(v) <- true;
      List.iter dfs (succ g v);
    ) in
  dfs source;
  visited

let exists_path g u v =
  (dfs g u).(v)

module Stack = Istack (* nos piles *)

(* Parcours en profondeur sans utiliser de récursivité.

   On utilise une pile contenant des paires (sommet v, liste de
   voisins de v restant à traiter).

   Temps O(E+V) espace O(V) comme pour la version récursive.
   L'espace est O(V) car chaque sommet n'est mis qu'au plus une fois
   dans la pile, et les listes de voisins ne sont que des pointeurs
   dans des listes qui existent déjà. *)
let dfs_stack (g: digraph) (source: int) : bool array =
  let visited = Array.make (size g) false in
  let st = Stack.create () in
  let add v = if not visited.(v) then ( (* pré-traitement de v ici *)
                visited.(v) <- true; Stack.push st (v, succ g v)) in
  add source;
  while not (Stack.is_empty st) do
    match Stack.pop st with
    | v, []      -> () (* post-traitement de v ici *)
    | v, w :: sv -> Stack.push st (v, sv); add w
  done;
  visited

let dfs_path (g: digraph) (source: int) : int array =
  let visited = Array.make (size g) false in
  let path = Array.make (size g) (-1) in
  let rec dfs p v =
    if not visited.(v) then (
      visited.(v) <- true;
      path.(v) <- p;
      List.iter (dfs v) (succ g v);
    ) in
  dfs source source;
  path

let rec build_path path acc v =
  if path.(v) = -1 then raise Not_found;
  if path.(v) = v then v :: acc
  else build_path path (v :: acc) path.(v)

let path g u v =
  let path = dfs_path g u in
  build_path path [] v

type color = Unvisited | InProgress | Visited

let has_cycle g source : bool =
  let color = Array.make (size g) Unvisited in
  let rec dfs v = match color.(v) with
    | Visited -> ()
    | InProgress -> raise Exit
    | Unvisited ->
        color.(v) <- InProgress;
        List.iter dfs (succ g v);
        color.(v) <- Visited
  in
  try dfs source; false with Exit -> true

module Queue = Iqueue (* nos files *)

let bfs (g: digraph) (source: int) : int array =
  let dist = Array.make (size g) max_int in
  dist.(source) <- 0;
  let q = Queue.create () in
  Queue.enqueue q source;
  while not (Queue.is_empty q) do
    let v = Queue.dequeue q in
    let d = dist.(v) in
    List.iter
      (fun w -> if dist.(w) = max_int then (
         dist.(w) <- d + 1;
         Queue.enqueue q w)
      )
      (succ g v)
  done;
  dist

let post_order (g: digraph) : int list =
  let visited = Array.make (size g) false in
  let order = ref [] in
  let rec dfs v =
    if not visited.(v) then (
      visited.(v) <- true;
      List.iter dfs (succ g v);
      order := v :: !order
    ) in
  for v = 0 to size g - 1 do dfs v done;
  !order

let matrix g =
  let n = size g in
  let m = Array.make_matrix n n 0 in
  let add i l = List.iter (fun j -> m.(i).(j) <- 1) l in
  Array.iteri add g;
  m

open Scanf

let load file =
  let c = Scanning.open_in file in
  let n = bscanf c "%d\n" (fun n -> n) in
  let g = create n in
  let e = bscanf c "%d\n" (fun e -> e) in
  for _ = 1 to e do bscanf c "%d %d\n" (add_edge g) done;
  g

open Format

let print fmt g =
  let n = size g in
  fprintf fmt "%d@\n" n;
  let e = Array.fold_left (List.fold_left (fun e _ -> e+1)) 0 g in
  fprintf fmt "%d@\n" e;
  for i = 0 to n - 1 do
    List.iter (fun j -> fprintf fmt "%d %d@\n" i j) g.(i)
  done

(* quelques graphes particuliers *)

let cycle n =
  let g = create n in
  for i = 0 to n-1 do add_edge g i ((i+1) mod n) done;
  g

let full ?(loop=false) n =
  let g = create n in
  for i = 0 to n-1 do
    for j = 0 to n-1 do
      if i <> j || loop then add_edge g i j
    done
  done;
  g

(* grille n*m où le sommet (i,j) est l'entier i*m+j,
   avec des arcs vers la droite et vers le bas *)
let grid n m =
  let g = create (n * m) in
  let v i j = i * m + j in
  for i = 0 to n-1 do
    for j = 0 to m-1 do
      if j < m-1 then add_edge g (v i j) (v i (j+1));
      if i < n-1 then add_edge g (v i j) (v (i+1) j)
    done
  done;
  g