#use "tp2.mli";;


module Tp2 : TP2 = struct

    exception Non_Implante of string

    (* Principaux types du Tp ------------------------------------------------ *)
    (* ----------------------------------------------------------------------- *)
    type programme = transition list * etat
    and  transition = etat * action * etat
    and  action = Epsilon | Api of string
    and  etat = int;;

    open List

    let pgm1 =
      ([(1, Api "a", 2); (2, Epsilon, 6); (2, Epsilon, 6); (6, Api "e", 7);
        (7, Epsilon, 7); (7, Api "exit", 10)],1);;

    let pgm2 =
      ([(1, Api "a", 2); (2, Epsilon, 5); (5, Epsilon, 6); (6, Api "c", 7);
        (7, Epsilon, 7); (1, Epsilon, 3); (3, Api "a", 4); (4, Epsilon, 4);
        (4, Api "b", 8)],1);;

    let pgm3 =
      ([(1, Epsilon, 2); (2, Api "a", 6); (6, Epsilon, 7); (7, Api "b", 10);
          (10, Epsilon, 10); (6, Api "c", 8); (1, Epsilon, 4);
          (4, Epsilon, 1)], 1);;

    let pgm4 =
      ([(0, Api "a", 6); (0, Epsilon, 3); (6, Api "b", 10); (6, Api "c", 8);
        (8, Epsilon, 8)],0);;

    let pgm30 = [ (7,[1;2]) ; (4, [3;4])];;
    let pgm32 = [(1, Epsilon, 2) ; (2, Api "a", 6) ; (6, Epsilon, 7) ; (7, Api "b", 10) ; (10, Epsilon, 10) ;(6, Api "c", 8) ; (1, Epsilon, 4) ; (4, Epsilon, 1)] ;;


    (* Fonctions du Tp à implanter ------------------------------------------- *)
    let isActionAPI (action : action) = match action with
    | Epsilon -> false
    | Api(_) -> true;;

    let rec getTransition listeTransition etatRecherche listeAPI listeEpsi  =
      match listeTransition with
      | [] -> (listeAPI,listeEpsi)
      | hd::tl -> match hd with
      | (etat1,action,etat2) when etat1 = etatRecherche && isActionAPI(action) = true-> getTransition tl etatRecherche (hd::listeAPI) listeEpsi
      | (etat1,action,etat2) when etat1 = etatRecherche && isActionAPI(action) = false -> getTransition tl etatRecherche listeAPI (hd::listeEpsi)
      | (_,_,_) -> getTransition tl etatRecherche listeAPI listeEpsi;;

    (*Deuxième fonction*)

      let ( <+ ) x l = exists (fun y -> x = y) l;; (* x appartient à l? *)
      let ( <++ ) etat l = exists (fun y -> etat = fst(y)) l;;
      let ( +: ) x l = if x <+ l then l else x::l;;  (* ajout x à l si x n'existe pas déjà dans l *)

      let rec getEpsiListeTransition listeTransition acc = match listeTransition with
      | [] -> acc
      | hd::tl -> match hd with
          | (etat1,action,etat2) ->if  isActionAPI(action) = false then getEpsiListeTransition tl ((etat1,action,etat2)::acc) else getEpsiListeTransition tl (acc) ;;

      let rec getAPIListeTransition listeTransition acc = match listeTransition with
          | [] -> acc
          | hd::tl -> match hd with
              | (etat1,action,etat2) ->if  isActionAPI(action) = true then getAPIListeTransition tl ((etat1,action,etat2)::acc) else getAPIListeTransition tl (acc) ;;

      let rec getSortedList listeEpsi listeAPI = match listeEpsi with
          | [] -> listeAPI
          | hd::tl ->getSortedList tl (hd::listeAPI);;


      let rec getEtats1ListeTransition listeTransition acc = match listeTransition with
      | [] -> acc
      | hd::tl -> match hd with
          | (etat1,action,etat2) -> getEtats1ListeTransition tl (etat1+:acc);;

      let rec getEtats2ListeTransition listeTransition acc = match listeTransition with
          | [] -> acc
          | hd::tl -> match hd with
              | (etat1,action,etat2) -> getEtats2ListeTransition tl (etat2+:acc);;

      let rec getMissingEtats2 listeEtats1 listeEtats2 acc = match listeEtats2 with
          | [] -> acc
          | hd::tl -> match hd with
              | (etat2) -> if(etat2 <+ listeEtats1) then getMissingEtats2 listeEtats1 tl acc else getMissingEtats2 listeEtats1 tl (etat2::acc) ;;


      let rec getListeConvenable listeElemManquant listeTransition  =
            match listeElemManquant with
            | [] -> listeTransition
            | hd::tl -> match hd with
                | (elem) ->  getListeConvenable tl ((elem,Api "fake",6969) :: listeTransition);;

       let actionEpsiImmediats transitions etat =
              fold_left (fun l (e1,action,e2) -> if e1 = etat && isActionAPI(action) = false  then e2 +: l else l)
                  [] transitions ;;

       let getEpsiSucc listeTransition etat =
                  let rec parcours etat acc =
                    let immediats = actionEpsiImmediats listeTransition etat in
                    let etats = filter (fun x -> not (x <+ acc)) immediats in
                    fold_left (fun l e -> parcours e l) (acc @ etats) etats
                  in
                  parcours etat [];;

        let getEpsilons listeTransition =
              let rec parcoursListe listeAjuste acc =
               match listeAjuste with
               | [] -> acc
               | hd::tl -> match hd with
                  | (etat1,action,etat2) when isActionAPI(action) = true -> if (etat1 <++ acc) = true then parcoursListe tl acc else parcoursListe tl ((etat1,[])::acc)
                  | (etat1,action,etat2) when isActionAPI(action) = false -> if (etat1 <++ acc) = true then parcoursListe tl acc else parcoursListe tl ((etat1,(getEpsiSucc listeTransition etat1))::acc)
              in parcoursListe listeTransition [];;


    (*Troisième fonction*)
    (* ----------------------------------------------------------------------- *)

    (* 5 points *)

    let transitionsImmediates pgm etat =
      match pgm with
      | (listeTransition,_)->  getTransition listeTransition etat [] [];;

    (* 30 points *)
    let epsilonAtteignable (pgm: programme) =
      match pgm with
      | (listeTransition,_)->  getEpsilons (getListeConvenable(getMissingEtats2  (getEtats1ListeTransition listeTransition []) (getEtats2ListeTransition listeTransition []) []) (getSortedList (getEpsiListeTransition listeTransition []) (getAPIListeTransition listeTransition [])));;

    (* 30 points *)
    let supprimeEpsilon pgm =
        raise (Non_Implante "supprimeEpsilon a completer");;

    (* 20 points *)
    let similaire pgm1 pgm2 =
        raise (Non_Implante "similaire a completer");;

    (* 5 points *)
    let bisimilaire pgm1 pgm2 =
        raise (Non_Implante "bisimilaire a completer");;

    (* 10 points *)
    let estSousPgm pgm1 pgm2 =
        raise (Non_Implante "estSousPgm a completer");;

end