Sys.command "ocaml -version";;

type intervalle = (int * int);;
type intervalles = intervalle list;;

type sommet = int;;
type voisins = sommet list;;
type graphe_intervalle = voisins list;;

let graphe_depuis_intervalles (intvls : intervalles) : graphe_intervalle =
    let n = List.length intvls in                   (* Nomber de sommet *)
    let array_intvls = Array.of_list intvls in      (* Tableau des intervalles *)
    let index_intvls = Array.to_list (
        Array.init n (fun i -> (
            array_intvls.(i), i)                    (* Associe un intervalle à son indice *)
        )
    ) in
    let gr = List.map (fun (a, b) ->                (* Pour chaque intervalle [a, b] *)
        List.filter (fun (x, y) ->                  (* On ajoute [x, y] s'il intersecte [a, b] *)
            (x, y) <> (a, b)                        (* Intervalle différent *)
            && not ( (b < x) || (y < a) )           (* pas x---y a---b ni a---b x---y *)
        ) intvls
    ) intvls in
    (* On transforme la liste de liste d'intervalles en une liste de liste d'entiers *)
    List.map (fun voisins ->
        List.map (fun sommet ->                     (* Grace au tableau index_intvls *)
            List.assoc sommet index_intvls
        ) voisins
    ) gr
;;

type couleur = int;;
type coloriage = (intervalle * couleur) list;;

let coloriage_depuis_couleurs (intvl : intervalles) (c : couleur array) : coloriage =
    Array.to_list (Array.init (Array.length c) (fun i -> (List.nth intvl i), c.(i)));;

let quelle_couleur (intvl : intervalle) (colors : coloriage) = 
    List.assoc intvl colors
;;

let ordre_partiel ((a, b) : intervalle) ((x, y) : intervalle) =
    a < x
;;

let inf_N_minus valeurs =
    let res = ref 0 in  (* Très important d'utiliser une référence ! *)
    while List.mem !res valeurs do
        incr res;
    done;
    !res
;;

inf_N_minus [0; 1; 3];;  (* 2 *)
inf_N_minus [0; 1; 2; 3; 4; 5; 6; 10];; (* 7 *)

let trouve_min_interval intvl (c : coloriage) (inf : couleur) =
    let colorie inter = quelle_couleur inter c in
    (* D'abord on extraie {I : c(I) = +oo} *)
    let intvl2 = List.filter (fun i -> (colorie i) = inf) intvl in
    (* Puis on parcourt la liste et on garde le plus petit pour l'ordre *)
    let i0 = ref 0 in
    for j = 1 to (List.length intvl2) - 1 do
        if ordre_partiel (List.nth intvl2 j) (List.nth intvl2 !i0) then
            i0 := j;
    done;
    List.nth intvl2 !i0;
;;

let coloriage_intervalles (intvl : intervalles) : coloriage =
    let n = List.length intvl in   (* Nombre d'intervalles *)
    let array_intvls = Array.of_list intvl in      (* Tableau des intervalles *)
    let index_intvls = Array.to_list (
        Array.init n (fun i -> (
            array_intvls.(i), i)                    (* Associe un intervalle à son indice *)
        )
    ) in
    let gr = graphe_depuis_intervalles intvl in
    let inf = n + 10000 in           (* Grande valeur, pour +oo *)
    let c = Array.make n inf in      (* Liste des couleurs, c(I) = +oo pour tout I *)
    let maxarray = Array.fold_left max (-inf - 10000) in  (* Initialisé à -oo *)
    while maxarray c = inf do      (* Il reste un I in V tel que c(I) = +oo *)
        begin (* C'est la partie pas élégante *)
            (* On récupère le coloriage depuis la liste de couleurs actuelle *)
            let coloriage = (coloriage_depuis_couleurs intvl c) in
            (* Puis la fonction [colorie] pour associer une couleur à un intervalle *)
            let colorie inter = quelle_couleur inter coloriage in
            (* On choisit un I, minimal pour ordre_partiel, tel que c(I) = +oo *)
            let inter = trouve_min_interval intvl coloriage inf in
            (* On trouve son indice *)
            let i = List.assoc inter index_intvls in
            (* On trouve les voisins de i dans le graphe *)
            let adj_de_i = List.nth gr i in
            (* Puis les voisins de I en tant qu'intervalles *)
            let adj_de_I = List.map (fun j -> List.nth intvl j) adj_de_i in
            (* Puis on récupère leurs couleurs *)
            let valeurs = List.map colorie adj_de_I in
            (* c(I) = inf(N - {c(J) : J adjacent a I} ) *)
            c.(i) <- inf_N_minus valeurs;
        end;
    done;
    coloriage_depuis_couleurs intvl c;
;;

let max_valeurs = List.fold_left max 0;;

let nombre_chromatique (colorg : coloriage) : int =
     1 + max_valeurs (List.map snd colorg)
;;

(* On définit des entiers, c'est plus simple *)
let ann = 0
and betty = 1
and cynthia = 2
and diana = 3
and emily = 4
and felicia = 5
and georgia = 6
and helen = 7;;

let graphe_densmore = [
    [betty; cynthia; emily; felicia; georgia];  (* Ann *)
    [ann; cynthia; helen]; (* Betty *)
    [ann; betty; diana; emily; helen]; (* Cynthia *)
    [cynthia; emily]; (* Diana *)
    [ann; cynthia; diana; felicia]; (* Emily *)
    [ann; emily]; (* Felicia *)
    [ann; helen]; (* Georgia *)
    [betty; cynthia; georgia] (* Helen *)
];;

let vaccins : intervalles = [
    (4, 12);
    (8, 15);
    (0, 20);
    (2, 3);
    (-3, 6);
    (-10, 10);
    (6, 20);
    (-5, 2);
    (-2, 8)
]

let graphe_vaccins = graphe_depuis_intervalles vaccins;;

coloriage_intervalles vaccins;;

nombre_chromatique (coloriage_intervalles vaccins);;

let csa : intervalles = [
    (32, 36);
    (24, 30);
    (28, 33);
    (22, 26);
    (20, 25);
    (30, 33);
    (31, 34);
    (27, 31)
];;

let graphe_csa = graphe_depuis_intervalles csa;;

coloriage_intervalles csa;;

nombre_chromatique (coloriage_intervalles csa);;

let restaurant = [
    (1170, 1214);
    (1230, 1319);
    (1140, 1199);
    (1215, 1259);
    (1260, 1319);
    (1155, 1229);
    (1200, 1259)
];;

let graphe_restaurant = graphe_depuis_intervalles restaurant;;

coloriage_intervalles restaurant;;

nombre_chromatique (coloriage_intervalles restaurant);;

(** Transforme un [graph] en une chaîne représentant un graphe décrit par le langage DOT,
    voir http://en.wikipedia.org/wiki/DOT_language pour plus de détails sur ce langage.

    @param graphname Donne le nom du graphe tel que précisé pour DOT
    @param directed Vrai si le graphe doit être dirigé (c'est le cas ici) faux sinon. Change le style des arêtes ([->] ou [--])
    @param verb Affiche tout dans le terminal.
    @param onetoone Si on veut afficher le graphe en mode carré (échelle 1:1). Parfois bizarre, parfois génial.
*)
let graph_to_dotgraph ?(graphname = "graphname") ?(directed = false) ?(verb = false) ?(onetoone = false) (glist : int list list) =
    let res = ref "" in
    let log s =
        if verb then print_string s; (** Si [verb] affiche dans le terminal le résultat du graphe. *)
        res := !res ^ s
    in
    log (if directed then "digraph " else "graph ");
    log graphname; log " {";
    if onetoone then
        log "\n   size=\"1,1\";";
    let g = Array.of_list (List.map Array.of_list glist) in
    (** On affiche directement les arc, un à un. *)
    for i = 0 to (Array.length g) - 1 do
        for j = 0 to (Array.length g.(i)) - 1 do
            if i < g.(i).(j) then
                log ("\n   \""
                ^ (string_of_int i) ^ "\" "
                ^ (if directed then "->" else "--")
                ^ " \"" ^ (string_of_int g.(i).(j)) ^ "\""
                );
        done;
    done;
    log "\n}\n// generated by OCaml with the function graphe_to_dotgraph.";
!res;;

(** Fonction ecrire_sortie : plus pratique que output. *)
let ecrire_sortie monoutchanel machaine =
    output monoutchanel machaine 0 (String.length machaine);
    flush monoutchanel;;

(** Fonction ecrire_dans_fichier : pour écrire la chaine dans le fichier à l'adresse renseignée. *)
let ecrire_dans_fichier ~chaine ~adresse =
    let mon_out_channel = open_out adresse in
    ecrire_sortie mon_out_channel chaine;
    close_out mon_out_channel;;


let s_graphe_densmore = graph_to_dotgraph ~graphname:"densmore" ~directed:false ~verb:false graphe_densmore;;
let s_graphe_vaccins = graph_to_dotgraph ~graphname:"vaccins" ~directed:false ~verb:false graphe_vaccins;;
let s_graphe_csa = graph_to_dotgraph ~graphname:"csa" ~directed:false ~verb:false graphe_csa;;
let s_graphe_restaurant = graph_to_dotgraph ~graphname:"restaurant" ~directed:false ~verb:false graphe_restaurant;;

ecrire_dans_fichier ~chaine:s_graphe_densmore ~adresse:"/tmp/densmore.dot" ;;
(* Sys.command "fdp -Tpng /tmp/densmore.dot > images/densmore.png";; *)

ecrire_dans_fichier ~chaine:s_graphe_vaccins ~adresse:"/tmp/vaccins.dot" ;;
(* Sys.command "fdp -Tpng /tmp/vaccins.dot > images/vaccins.png";; *)

ecrire_dans_fichier ~chaine:s_graphe_csa ~adresse:"/tmp/csa.dot" ;;
(* Sys.command "fdp -Tpng /tmp/csa.dot > images/csa.png";; *)

ecrire_dans_fichier ~chaine:s_graphe_restaurant ~adresse:"/tmp/restaurant.dot" ;;
(* Sys.command "fdp -Tpng /tmp/restaurant.dot > images/restaurant.png";; *)