(*** Correction - TP : Algorithme de Berry-Sethi ***)

(* type pour les regexp et les regexp linéarisées *)

type regexp = Vide | Epsilon | C of char * int 
| Concat of regexp * regexp | Union of regexp * regexp | Etoile of regexp

(* C of char*int permettra de linéariser la rexgep*)


(* type pour représenter l'automate final. *)
(* NB : les transitions sont représentées par une liste de triplets *)

type autoND = { initial:int; final:int list; transitions:(int * char * int) list }


(* fonctions d'affichage *)

let rec afficheRegexp r = match r with
  | Vide -> print_string("vide")
  | Epsilon -> print_string("eps")
  | Concat (r1,r2) -> afficheRegexp r1; afficheRegexp r2
  | Etoile (r) -> print_string("("); afficheRegexp r; print_string(")*")
  | Union (r1,r2) -> print_string("("); afficheRegexp r1; 
    print_string("|"); afficheRegexp r2; print_string(")")
  | C (c,i) -> Printf.printf "%c%d" c i

let afficheAutomate aut =
  Printf.printf "initial:%d\n" aut.initial;
  print_string "final:["; List.iter (fun q -> Printf.printf "%d," q) aut.final; print_string "]\n";
  print_string "transitions:["; List.iter (fun (q1,c,q2) -> Printf.printf "%d-%c-%d," q1 c q2) aut.transitions; print_string "]\n";;


(* exemples *)

let r0 =
  Concat (
    Concat (C('a', 0),
            Etoile (Concat (C('b',0), C('a',0)))),
    Etoile (C('c', 0)));;

let r1 = 
  Concat (
    Etoile (Concat (C('a',0), C('b',0))),
    Concat (Concat (C('c',0), C('a',0)),
            Etoile (Union (C('c', 0), Concat (C('b',0), C('a', 0))))));;

(*linéarise une regexp *)
let linearise r = 
  let indice = ref 0 in 
  let rec auxlin r = match r with 
    (* décore l'arborescence en numétorant les caractères *)
    | Vide -> Vide 
    | Epsilon -> Epsilon 
    | Concat (r1,r2) -> 
      let rl1 = auxlin r1 in 
      let rl2 = auxlin r2 in Concat (rl1, rl2)
    | Etoile (r) -> Etoile (auxlin r)
    | Union (r1,r2) -> 
      let rl1 = auxlin r1 in 
      let rl2 = auxlin r2 in Union (rl1, rl2)
    | C (c,i) -> indice := !indice + 1; C(c,!indice)
  in auxlin r;; 


afficheRegexp r0;; print_newline ();;
afficheRegexp (linearise r0);; print_newline ();;

afficheRegexp r1;; print_newline ();;
afficheRegexp (linearise r1);; print_newline ();;

(* on représente les ensembles comme des listes sans doublons *)
(* quelques fonctions utilitaires *)

let rec ajouteSansDoublons l e = match l with 
| [] -> [e]
| x::ll -> if x = e then l else x :: (ajouteSansDoublons ll e);;

let rec unionSansDoublons l1 l2 = match l1 with
| [] -> l2
| x::ll -> unionSansDoublons ll (ajouteSansDoublons l2 x)

let rec produitListes l1 l2 = (* construit la liste des couples *)
let rec prodElement e l = match l with
| [] -> []
| x::ll -> (e,x)::prodElement e ll
in
match l1 with
| [] -> []
| x::ll -> (prodElement x l2) @ produitListes ll l2


let rec contientVide r = (* vérifie si une regexp contient le mot vide *)
  match r with
  | Vide -> false
  | Epsilon -> true
  | C (c,i) -> false
  | Concat (r1,r2) -> contientVide r1 && contientVide r2
  | Etoile (r) -> true
  | Union (r1,r2) -> contientVide r1 || contientVide r2

(* renvoie P(L) -> (char * int) list *)
let rec p r = match r with  
| Vide -> []
| Epsilon -> []
| C (c,i) -> [(c,i)]
| Concat (r1,r2) -> if contientVide r1 then unionSansDoublons (p r1) (p r2) else p r1
| Etoile (r) -> p r
| Union (r1,r2) -> unionSansDoublons (p r1) (p r2)

(* renvoie S(L) -> (char * int) list *)
let rec s r = match r with  
| Vide -> []
| Epsilon -> []
| C (c,i) -> [(c,i)]
| Concat (r1,r2) -> if contientVide r2 then unionSansDoublons (s r1) (s r2) else s r2
| Etoile (r) -> s r
| Union (r1,r2) -> unionSansDoublons (s r1) (s r2)

(* renvoie F(L) -> ((char * int) * (char * int)) list *)
let rec f r = match r with  
| Vide -> []
| Epsilon -> []
| C (c,i) -> []
| Concat (r1,r2) -> unionSansDoublons (unionSansDoublons (f r1) (f r2)) (produitListes (s r1) (p r2))
| Etoile (r) -> unionSansDoublons (f r) (produitListes (s r) (p r))
| Union (r1,r2) -> unionSansDoublons (f r1) (f r2)

let affichePSF p s f =
  print_string "P:["; List.iter (fun (c,i) -> Printf.printf "%c%d," c i) p; print_string "]\n";
  print_string "S:["; List.iter (fun (c,i) -> Printf.printf "%c%d," c i) s; print_string "]\n";
  print_string "F:["; List.iter (fun ((c1,i1),(c2,i2)) -> Printf.printf "%c%d%c%d," c1 i1 c2 i2) f; print_string "]\n";;

affichePSF (p r0) (s r0) (f r0);;
affichePSF (p r1) (s r1) (f r1);;

(* NB OPTIM : les fonctions f s p contientVide explorent toutes l'arbre en entier.
 Pour ne parcourir qu'une seule fois l'arbre, on peut implémenter une fonction qui renvoie
 les 4 informations à la fois ! *)

let berrysethi r =
  (* etat initial 0, les autres états : les numéros des caractères *)
  let rlin = linearise r in 
  let pr, sr, fr = p rlin, s rlin, f rlin in
  let final = 
    let sfin = List.map (fun (c,i) -> i) sr in
    if contientVide r then 0::sfin else sfin in
  let trans1 = List.map (fun (c,i) -> (0,c,i)) pr in
  let trans2 = List.map (fun ((c1,i1),(c2,i2)) -> (i1,c2,i2)) fr in
  {initial = 0; final = final; transitions = trans1@trans2 }

let aut0 = berrysethi r0;;

afficheAutomate aut0;;

let aut1 = berrysethi r1;;

afficheAutomate aut1;;