type 'a expr_rat=
  | Vide
  | Eps
  | Lettre of 'a
  | Concat of ('a expr_rat)*('a expr_rat)
  | Etoile of ('a expr_rat)
  | Plus of ('a expr_rat)*('a expr_rat);;

let rec ecrire_exp_rat_general action=function
  | Vide -> print_string "Vide"
  | Eps -> print_string "Eps"
  | Lettre(a) -> action a
  | Etoile(Lettre l)-> action l;print_string "*"
  | Etoile(e)->print_string "(";
      ecrire_exp_rat_general action e; print_string ")*"
  | Concat(Plus(e1,e2),Plus(e3,e4))->print_string "(";
      ecrire_exp_rat_general action (Plus(e1,e2));print_string ")(";
      ecrire_exp_rat_general action (Plus(e3,e4));print_string ")"
  | Concat(Plus(e1,e2),e)->print_string "(";
      ecrire_exp_rat_general action (Plus(e1,e2));print_string ")";
      ecrire_exp_rat_general action e;
  | Concat(e,Plus(e3,e4))->
      ecrire_exp_rat_general action e;print_string "(";
      ecrire_exp_rat_general action (Plus(e3,e4));print_string ")"
  | Concat(e1,e2)->ecrire_exp_rat_general action e1;
      ecrire_exp_rat_general action e2
  | Plus(e1,e2)->ecrire_exp_rat_general action e1;
      print_string "+";ecrire_exp_rat_general action e2;;
(*ecrire_exp_rat_general : ('a -> unit) -> 'a expr_rat -> unit = <fun>*)

type 'a automate={
  A :'a list;
  Q : int;
  initiaux : int list;
  finaux : int list;
  transitions: (int*'a*int)list};;

let auto2=
  {A=[0;1];Q=3;initiaux=[1];finaux=[1;3];
   transitions=[1,1,1;1,0,1;1,0,2;1,0,3;2,0,2;2,1,3;3,0,1;3,0,2;3,1,3]};;


let additionner =function
  | (Vide,e)->e | (e,Vide)->e | (e1,e2)->Plus(e1,e2);;
(*additionner : 'a expr_rat * 'a expr_rat -> 'a expr_rat = <fun>*)

let etoiler=function
  | Vide -> Eps | Eps -> Eps | Etoile(e)->Etoile(e) | e->Etoile(e);;
(*etoiler : 'a expr_rat -> 'a expr_rat = <fun>*)

let concatener =function
  | (Vide,_)->Vide | (_,Vide)->Vide
  | (Eps,e)->e | (e,Eps)->e
  | (e1,e2)->Concat(e1,e2);;
(*concatener : 'a expr_rat * 'a expr_rat -> 'a expr_rat = <fun>*)

let rec initialise_M m=function
  | []->();
  | f::reste->m.(f)<-Eps; initialise_M m reste;;
(*initialise_M : 'a expr_rat vect -> int list -> unit = <fun>*)

let rec initialise_K k=function
  | []->();
  | (d,l,f)::reste->
      k.(d).(f)<-(match k.(d).(f) with
		    | Vide -> Lettre l;
		    | e -> additionner(Lettre l,e));
      initialise_K k reste;;
(*initialise_K : 'a expr_rat vect vect -> (int * 'a * int) list -> unit = <fun>*)

let rec reconstituer_L m=function
  | [] -> Vide
  | [f]-> m.(f)
  | f::reste->additionner(m.(f),reconstituer_L m reste);;
(*reconstituer_L : 'a expr_rat vect -> int list -> 'a expr_rat = <fun>*)

let arden a=
  let n=a.Q in 
  let K=make_matrix (n+1) (n+1) Vide
  and M=make_vect (n+1) Vide
  in 
    begin
      initialise_M M a.finaux;
      initialise_K K a.transitions;
      for l=n downto 1
      do
	for i=1 to l-1
	do  K.(l).(i)<-concatener(etoiler(K.(l).(l)),K.(l).(i)) done;
	M.(l)<-concatener(etoiler(K.(l).(l)),M.(l));
	K.(l).(l)<-Vide; (* pas indispensable, mais bon... *)
	  (* reportons dans les equations precedentes *)
	for ligne=1 to l-1
	do
	  for i=1 to l-1
	  do 
	    K.(ligne).(i)<-additionner(
	      K.(ligne).(i),
	      concatener(K.(ligne).(l),K.(l).(i)))
	  done;
	  M.(ligne)<-additionner(M.(ligne),concatener(K.(ligne).(l),M.(l)));
	  K.(ligne).(l)<-Vide
	done;
      done; (* jusqu'ici, c'est OK *)
      for l=2 to n
      do
	for i=1 to l-1
	do M.(l)<-additionner(M.(l),concatener(K.(l).(i),M.(i))) done
      done;
      reconstituer_L M a.finaux
    end;; 
(*arden : 'a automate -> 'a expr_rat = <fun>*)

let auto1={A=[0;1];Q=3;initiaux=[1];finaux=[3];
   transitions=[1,0,2;2,0,2;2,1,3;3,0,1]};;

arden auto2;;
arden auto1;;


ecrire_exp_rat_general print_int (arden auto1);;
(*Eps+0(00*10)*00*1- : unit = ()*)
ecrire_exp_rat_general print_int (arden auto2);;
(*(0+1+01*0+(0+01*0)(0+11*0)*11*0)*(Eps+01*+(0+01*0)(0+11*0)*11*)+1*+1*0(0+1+01*0+(0+01*0)(0+11*0)*11*0)*(Eps+01*+(0+01*0)(0+11*0)*11*)+1*0((0+11*0)*11*+(0+11*0)*11*0(0+1+01*0+(0+01*0)(0+11*0)*11*0)*(Eps+01*+(0+01*0)(0+11*0)*11*))- : unit = ()*)


let rec initialise k0=function
  | []-> ()
  | (i,a,j)::reste->
      k0.(i).(j)<-additionner(k0.(i).(j),Lettre(a));
      initialise k0 reste;;
(*initialise : 'a expr_rat vect vect -> (int * 'a * int) list -> unit = <fun>*)

let rec reconstituer_langage k initio fino=
  let rec un_initial i=
    (function
       | [] -> Vide
       | f::reste -> 
	   additionner(k.(i).(f),un_initial i reste))
  in match initio with
    | [] -> Vide
    | i::reste->additionner
	(un_initial i fino,reconstituer_langage k reste fino);;
(*reconstituer_langage :
'a expr_rat vect vect -> int list -> int list -> 'a expr_rat = <fun>*)

let pas_arden a=
  let n=a.Q in 
  let K0=ref (make_matrix (n+1) (n+1) Vide)
  and K1=make_matrix (n+1) (n+1) Vide
  in 
    begin
      initialise !K0 a.transitions;
      for k=0 to n-1
      do
	for i=1 to n do for j=1 to n do
	  K1.(i).(j)<-
	  additionner(!K0.(i).(j),
		      concatener(!K0.(i).(k+1),
				 concatener(etoiler(!K0.(k+1).(k+1)),
					    !K0.(k+1).(j))))
	done done;
	K0:=K1
      done;
    end;
    reconstituer_langage !K0 a.initiaux a.finaux;; 
(*pas_arden : 'a automate -> 'a expr_rat = <fun>*)


ecrire_exp_rat_general print_int (pas_arden auto1);;
(*(0+00*0)0*1+(0+00*0)0*1((00+00(0+00*0)*(0+00*0))(0+00*0)*(1+(0+00*0)(0+00*0)*1))*(00+00(0+00*0)*(0+00*0))(0+00*0)*(1+(0+00*0)(0+00*0)*1)- : unit = ()*)

ecrire_exp_rat_general print_int (pas_arden auto2);;
(*1+0+(1+0)(1+0)*(1+0)+(0+(1+0)(1+0)*0+(0+(1+0)(1+0)*0+(0+(1+0)(1+0)*0)0*0)0*1)(1+0(1+0)*0+(0+0(1+0)*0+(0+0(1+0)*0)(0+00*0)*(0+00*0))(0+00*0)*(1+(0+00*0)(0+00*0)*1))*(0+0(1+0)*(1+0))+0+(1+0)(1+0)*0+(0+(1+0)(1+0)*0+(0+(1+0)(1+0)*0)0*0)0*1+(0+(1+0)(1+0)*0+(0+(1+0)(1+0)*0+(0+(1+0)(1+0)*0)0*0)0*1)(1+0(1+0)*0+(0+0(1+0)*0+(0+0(1+0)*0)(0+00*0)*(0+00*0))(0+00*0)*(1+(0+00*0)(0+00*0)*1))*(1+0(1+0)*0+(0+0(1+0)*0+(0+0(1+0)*0)(0+00*0)*(0+00*0))(0+00*0)*(1+(0+00*0)(0+00*0)*1))- : unit = ()

Arf !
*)