Sys.command "ocaml -version";;

type entier_etendu = MInf | PInf | E of int;;

type intervalle = (entier_etendu * entier_etendu);;  (* (a, b) représente l'intervalle [a, b] *)

type intervalles = intervalle list;;

let t_a : intervalles = [
    (E(1), E(4));
    (E(6), E(8))
];;

let s_a : intervalles = [
    (E(0), E(1));
    (E(3), E(5));
    (E(6), E(7))
];;

let t_b : intervalles = [
    (E(-1), E(0));
    (E(2), E(4))
];;

let s_b : intervalles = [
    (E(0), E(1));
    (E(4), E(4))  (* Intervalle de longueur nulle *)
];;

let t_vide : intervalles = [
    (MInf, PInf)
];;

let max_ee x y =
    match x, y with
    | MInf, _ -> y
    | PInf, _ -> PInf
    | _, MInf -> x
    | _, PInf -> PInf
    | E(vx), E(vy) -> E(max vx vy)
;;

max_ee MInf (E(10));;
max_ee PInf (E(10));;
max_ee (E(10)) MInf;;
max_ee (E(10)) PInf;;
max_ee (E(-10)) (E(10));;
max_ee (E(10)) (E(-10));;

let min_ee x y =
    match x, y with
    | PInf, _ -> y
    | MInf, _ -> MInf
    | _, PInf -> x
    | _, MInf -> MInf
    | E(vx), E(vy) -> E(min vx vy)
;;

min_ee MInf (E(10));;
min_ee PInf (E(10));;
min_ee (E(10)) MInf;;
min_ee (E(10)) PInf;;
min_ee (E(-10)) (E(10));;
min_ee (E(10)) (E(-10));;

let pluspetiteq_ee x y =
    let m = min_ee x y in
    m = x || x = y
;;

let pluspetit_ee x y =
    let m = min_ee x y in
    m = x && x != y
;;

let plus_ee x y =
    match x, y with
    | MInf, PInf -> failwith "-inf + +inf = ?"
    | PInf, MInf -> failwith "-inf + +inf = ?"
    | PInf, _ -> PInf
    | MInf, _ -> MInf
    | _, MInf -> MInf
    | _, PInf -> PInf
    | E(vx), E(vy) -> E(vx + vy)
;;

plus_ee MInf (E(10));;
plus_ee PInf (E(10));;
plus_ee (E(10)) MInf;;
plus_ee (E(10)) PInf;;
plus_ee (E(-10)) (E(10));;
plus_ee (E(10)) (E(-10));;
plus_ee (E(10)) (E(10));;
plus_ee (E(-10)) (E(-10));;

let produit_ee x y =
    match x, y with
    | MInf, PInf -> MInf
    | PInf, MInf -> PInf
    | PInf, E(vy) when vy < 0 -> MInf
    | PInf, _ -> PInf
    | MInf, E(vy) when vy < 0 -> PInf
    | MInf, _ -> MInf
    | E(vx), PInf when vx < 0 -> MInf
    | _, PInf -> PInf
    | E(vx), MInf when vx < 0 -> PInf
    | _, MInf -> MInf
    | E(vx), E(vy) -> E(vx * vy)
;;

produit_ee MInf (E(10));;
produit_ee PInf (E(10));;
produit_ee (E(10)) MInf;;
produit_ee (E(10)) PInf;;
produit_ee (E(-10)) (E(10));;
produit_ee (E(10)) (E(-10));;
produit_ee (E(10)) (E(10));;
produit_ee (E(-10)) (E(-10));;

let intersection (i : intervalle) (j : intervalle) : intervalle option =
    let a = fst i and b = snd i in
    let c = fst j and d = snd j in
    if pluspetit_ee b c || pluspetit_ee d a then
        None
    else
        Some (max_ee a c, min_ee b d)
;;

let ajoute_nouveaux_option (acc : intervalles) (liste_option : intervalle option list) =
    List.map
    (fun i -> match i with Some i2 -> i2 | None -> (MInf, PInf))
    (List.filter (fun i ->
        match i with
        | None -> false
        | Some i2 -> not (List.mem i2 acc)
    ) liste_option)
;;

let intersections (t : intervalles) (s : intervalles) : intervalles =
    let rec inter_aux acc tx sx =
        match sx with
        | [] -> acc    (* Plus rien à ajouter *)
        | j :: s2 ->   (* On traite j, puis récursivement la suite de s *)
            let t_inter_j = List.map (intersection j) tx in
            inter_aux ((ajoute_nouveaux_option acc t_inter_j) @ acc) tx s2
    in
    List.sort compare (inter_aux [] t s)
    (* On trie pour les avoir en ordre croissant, c'est tout *)
;;

let ( ++ ) = intersections;;

let composition (i : intervalle) (j : intervalle) : intervalle =
    let a = fst i and b = snd i in
    let c = fst j and d = snd j in
    (* (a + c, b + d) *)
    ((plus_ee a c), (plus_ee d b))
;;

let ajoute_nouveaux (acc : intervalles) (liste : intervalles) : intervalles =
    List.filter (fun i -> not (List.mem i acc)) liste
;;

let compositions (t : intervalles) (s : intervalles) : intervalles =
    let rec compo_aux acc tx sx =
        match sx with
        | [] -> acc    (* Plus rien à ajouter *)
        | j :: s2 ->   (* On traite j, puis récursivement la suite de s *)
            let t_compo_j = List.map (composition j) tx in
            compo_aux ((ajoute_nouveaux acc t_compo_j) @ acc) tx s2
    in
    List.sort compare (compo_aux [] t s)
    (* On trie pour les avoir en ordre croissant, c'est tout *)
;;

let ( ** ) = compositions;;

let union (t : intervalles) (s : intervalles) : intervalles =
    List.append t s
;;

t_a ++ s_a;;

t_a ** s_a;;
union t_a s_a;;

t_b ** s_b;;

t_b;;
s_b;;

t_b ++ s_b;;
union t_b s_b;;

let est_inclus (i : intervalle) (j : intervalle) : bool =
    let a = fst i and b = snd i in
    let c = fst j and d = snd j in
    (* on peut aussi écrire directement
    let a, b = i and c, d = j in
    pour extraire les valeurs d'un coupe i=(a,b) et j=(c,d)
    *)
    (* c <= a && b <= d *)
    (pluspetiteq_ee c a) && (pluspetiteq_ee b d)
;;

est_inclus (E(3), E(4)) (E(2), E(5));; (* true *)
est_inclus (E(2), E(5)) (E(3), E(4));; (* false *)
est_inclus (E(1), E(1)) (E(1), E(1));; (* true *)

let est_inclus_dans_un (i : intervalle) (acc : intervalles) : bool =
    List.exists (fun j -> (i != j) && (est_inclus i j)) acc
;;

let retire_les_inclus (liste : intervalles) : intervalles =
    List.filter (fun i -> not (est_inclus_dans_un i liste)) liste
;;

let retire_les_doublons (liste : intervalles) : intervalles =
    let reponse = ref [] in
    List.iter (fun i ->
        if not (List.mem i !reponse) then
        reponse := i :: !reponse
    ) liste;
    !reponse
;;

let filtre liste =
    retire_les_doublons (retire_les_inclus liste)
;;

let intersections2 (t : intervalles) (s : intervalles) : intervalles =
    List.sort compare (filtre (intersections t s))
    (* On trie pour les avoir en ordre croissant, c'est tout *)
;;

let ( ++ ) = intersections2;;

t_a ++ s_a;;

let compositions2 (t : intervalles) (s : intervalles) : intervalles =
    List.sort compare (filtre (compositions t s))
    (* On trie pour les avoir en ordre croissant, c'est tout *)
;;

let ( ** ) = compositions2;;

t_b ** s_b;;

type sommet = int;;
type arete = intervalles;; (* c'est l'idée *)

type reseauSTP = intervalles array array;;

let t_01 : intervalles = [(E(0), E(1)); (E(10), E(20))];;
let t_12 : intervalles = [(E(0), E(10))];;
let t_13 : intervalles = [(E(25), E(50))];;
let t_23 : intervalles = [(E(0), E(20)); (E(40), E(40))];;

let t_vide = [(MInf, PInf)];;

let stp_4 : reseauSTP = [|
    [| t_vide; t_01;   t_vide; t_vide |];
    [| t_vide; t_vide; t_12;   t_13 |];
    [| t_vide; t_vide; t_vide; t_23 |];
    [| t_vide; t_vide; t_vide; t_vide |];
|];;

let s_13 = t_12 ** t_23;;

t_13 ++ s_13;;
t_01 ** (t_13 ++ s_13);;  (* 1er cas *)

t_01 ** t_13;;
t_01 ** s_13;;
(t_01 ** t_13) ++ (t_01 ** s_13);; (* 2nd cas *)

let est_carree matrice =
    let n = Array.length matrice in
    Array.fold_left (fun b x -> b && (n = (Array.length x))) true matrice
;;

est_carree stp_4;;

exception Fini;; (* Pour faire le [exit]. *)

let relaxe (reseau : reseauSTP) i j k =
    let t_ij = reseau.(i).(j)
    and t_ik = reseau.(i).(k)
    and t_kj = reseau.(k).(j)
    in t_ij ++ (t_ik ** t_kj)
;;

let string_of_entieretendu = function
    | MInf -> "-oo"
    | PInf -> "+oo"
    | E(x) -> string_of_int x
;;

let print_intervalle (une_contrainte : intervalle) =
    let a, b = une_contrainte in
    Printf.printf "(%s, %s) " (string_of_entieretendu a) (string_of_entieretendu b)
;;

let print_intervalles (contraintes : intervalles) =
    List.iter print_intervalle contraintes
;;

let flush_force () =
    Printf.printf "\n";
    flush_all();
    Printf.printf "\n";
    flush_all();
    Printf.printf "\n";
    flush_all();
;;

let print_reseau (reseau : reseauSTP) : unit =
    flush_force ();
    Printf.printf "\nReseau =\n";
    Array.iteri (fun i ligne ->
        Array.iteri (fun j case ->
            if case != [(MInf, PInf)] then begin
            Printf.printf "\n    T[i=%i, j=%i] = [" i j;
            print_intervalles case;
            Printf.printf "]";
        end) ligne
    ) reseau;
    flush_all ();
;;

stp_4;;

flush_force();;

print_reseau stp_4;;

let algorithmePC ?(max_etape=10) (reseau : reseauSTP) : (reseauSTP * intervalles list) =
    let resT = Array.map Array.copy reseau in (* on ne modifie pas l'entrée *)
    let resS = ref [||] in
    let n = Array.length resT in
    let allseen = ref [] in (* Pour débogguer, je veux la liste des Tij vus *)
    let etape = ref 0 in
    begin
        try begin
        while !etape < max_etape && !resS != resT do
            incr etape;
            resS := Array.map Array.copy resT; (* S := T *)
            for k = 0 to n - 1 do
                for i = 0 to n - 1 do
                    for j = 0 to n - 1 do
                        Printf.printf "\n\nEtape %i, k = %i, i = %i, j = %i.\n" !etape k i j;
                        print_string "Contraintes :";
                        print_reseau resT;
                        resT.(i).(j) <- relaxe resT i j k;
                        allseen := (resT.(i).(j)) :: !allseen; (* on l'ajoute *)
                        if resT.(i).(j) = [] then
                            raise Fini
                    done
                done
            done
        done;
        end
        with Fini -> () (* On ignore l'exception, on a juste terminé. *)
    end;
    resT, !allseen
;;

stp_4;;

relaxe stp_4 1 2 3;;

stp_4.(1).(3)



algorithmePC stp_4;;

let t_01 : intervalles = [(E(10), E(20))];;
let t_12 : intervalles = [(E(30), E(40))];;
let t_32 : intervalles = [(E(10), E(20))];;
let t_34 : intervalles = [(E(20), E(30)); (E(40), E(50))];;
let t_40 : intervalles = [(E(60), E(70))];;

let stp_1 : reseauSTP = [|
    [| t_vide; t_01; t_vide; t_vide; t_vide |];
    [| t_vide; t_vide; t_12; t_vide; t_vide |];
    [| t_vide; t_vide; t_vide; t_vide; t_vide   |];
    [| t_vide; t_vide; t_32; t_vide; t_34 |];
    [| t_40; t_vide; t_vide; t_vide; t_vide |];
|];;

print_reseau stp_1;;

algorithmePC stp_1;;