type ('a , 'b) adc = {
	initial : 'a;
	est_final : 'a -> bool;
	delta : 'a -> 'b -> 'a };;

let ex =
	let d e l = match e,l with
		 0,'a' -> 1
		|0,'b' -> 0
		|1,'a' -> 0
		|1,'b' -> 1
		|_ -> 2
	in
	let f = function
		0 -> true
		|_ -> false
	in
	{initial = 0;
	est_final = f;
	delta = d};;


let aut1 = 
	let d e l =  match e,l with
		 0,'a' -> 2
		|0,'b' -> 1
		|0,'c' -> 3
		|1,'a'|1,'b' -> 2
		|1,'c' -> 3
		|2,'a'|2,'b' -> 2
		|2,'c' -> 3
		|_ -> 4
	in
	let f = function
		1|3 -> true
		|_ -> false
	in
	{
	initial = 0;
	est_final = f;
	delta = d
		};;

let list_of_string s = 
	let n = String.length s in
	let rec aux i =
		match i with
			0 -> []
			|_ -> s.[n-i]::(aux (i-1))
	in
	aux n;;

		
let rec delta_etoile aut q w = 
	match w with
		[] -> q
		|a::r -> delta_etoile aut (aut.delta q a) r;;
		
delta_etoile aut1 0 ['b';'a';'a';'c'];;

let reconnait aut w = aut.est_final (delta_etoile aut aut.initial w);;


let produit a1 a2 = 
   let d (q1, q2) a = (a1.delta q1 a, a2.delta q2 a) in
   let f (q1, q2) = ((a1.est_final q1) && (a2.est_final q2)) in
	{
	initial = (a1.initial, a2.initial);
	est_final = f;
	delta = d
	};;

type ('a , 'b) nda = {
	initiaux : 'a list;
	est_final_nd : 'a -> bool;
	delta_nd : 'a -> 'b -> 'a list };;
	

let rec union l1 l2 =
(* suppose que les listes sont tri es *)
	match l1,l2 with
		[],_ -> l2
		|_,[] -> l1
		|a::q,b::r when a<b -> a::(union q l2)
		|a::q,b::r when a=b -> union q l2
		|a::q,b::r  -> b::(union l1 r);;


let rec delta_etoile_nd aut l w =
	match w with
		[] -> l
		|a::r -> let rec aux l2 =
						match l2 with
							[] -> []
							|q::s -> union (aux s) (aut.delta_nd q a)
					in
					delta_etoile_nd aut (aux l) r
		;;
		
(* variante en matchant les deux listes en m me temps *)

let rec delta_etoile_nd aut l w =
	match l,w with
		_,[] -> l
		|[],_ -> []
		|b::q, a::r -> union (delta_etoile_nd  aut (aut.delta_nd b a) r) (delta_etoile_nd aut q w)
		;;


(* variante avec List.fold_left *)

let rec delta_etoile_nd aut l w =
	match w with
		[] -> l
		|a::r -> delta_etoile_nd aut ( List.fold_left  (fun l' q -> union l' (aut.delta_nd q a))  []  l ) r;;


let reconnait_nd aut w = 
	List.exists aut.est_final_nd (delta_etoile_nd aut aut.initiaux w) ;;

let aut2 =
	let d q a = 
		match q,a with
		0,'a' -> [0;1]
		|0,_-> [0]
		|1,'b' -> [2]
		|1,_ -> [6]
		|2,'c' -> [3]
		|2,_ -> [6]
		|3,_ -> [3]
		|4,'a' -> [5]
		|_ -> [6]	
	in 
	let f = function 3|5 -> true |_ -> false in	
	{
	initiaux = [0;4];
	est_final_nd = f;
	delta_nd = d};;
	
reconnait_nd aut2 (list_of_string "b");;



	
let determinise aut_nd = 
	let q0 =  aut_nd.initiaux in
	let f p = List.exists aut_nd.est_final_nd p in	
	let d p a = delta_etoile_nd aut_nd p [a] in
	{
	initial = q0;
	est_final = f;
	delta = d	
	};;
	
let aut3 = determinise aut2;;

reconnait aut3 (list_of_string "b");;


type 'b regexp =
	Epsilon |
	Lettre of 'b |
	Plus of 'b regexp * 'b regexp |
	Concat of 'b regexp * 'b regexp |
	Etoile of 'b regexp ;;



let rec concat l1 l2 =
		match l1 with
		[] -> []
		|a::q -> 
			let rec aux l =
				match l with
					[] -> concat q l2
					|b::r -> (a,b)::aux r
			in
			aux l2;;



let rec psf e = 
	(* renvoie b , P ,S, F , o  b est le bool en indiquant si epsilon est reconnu par e *)
	match e with 
		Epsilon ->  true, [] , [] ,[]
		| Lettre(a) -> false , [a] , [a] , []
		|Plus(e1,e2) -> let b1,p1,s1,f1 = psf e1 in 
						let b2,p2,s2,f2 = psf e2 in 
						b1 || b2, union p1 p2, union s1 s2, union f1 f2
		|Concat(e1,e2) -> let b1,p1,s1,f1 = psf e1 in 
						let b2,p2,s2,f2 = psf e2 in 
						(b1 && b2,(if b1 then union p1 p2 else p1),(if b2 then union s1 s2 else s2),union f1 (union f2 (concat s1 p2)))
		|Etoile(e') ->  let b',p',s',f' = psf e' in
					true, p',s',union f' (concat s' p');; 


let marquage e =
	let i = ref 0 in
	let rec aux e = 
		match e with
			Epsilon -> Epsilon
			|Lettre(a) -> incr i ; Lettre((a,!i))
			|Plus(e1,e2) -> Plus(aux e1, aux e2)
			|Concat(e1,e2) -> Concat(aux e1, aux e2)
			|Etoile(e') -> Etoile(aux e')
	in
	aux e;;


let sigma_et = Etoile( Plus(Lettre('a') , Plus(Lettre('b'),Lettre('c'))));;
					
let e = Concat(sigma_et , Concat( Lettre('a') , Concat( Lettre('b') , Concat( Lettre('c') , sigma_et  )   )  )   ) ;;

psf e;;

(* e = S*abcS* *)

let el = marquage e;;

let b,p,s,f = psf el;;



let glushkov e =
	let el = marquage e in
	let b , p,s,f = psf el in
	let q0 = 0 in
	let qf p = if p = q0 then b else List.mem p (List.map (fun (a,b) -> b) s) in
	let liste_p a =
		let rec aux l =
			match l with
				[] -> []
				|(b,i)::r when b = a -> i::(aux r)
				|_::r -> aux r
		in
		List.sort compare (aux p)
	in
	
	let liste_f i a =
		let rec aux l = 
			match l with
				[] -> []
				|((c,k),(d,j))::r when k=i && d=a -> j::(aux r)
				|_::r -> aux r
		in
	List.sort compare (aux f)
	in
	
	let d q a = 	
		if q = q0 then liste_p a 
		else liste_f q a
	in
	let nda = {
	initiaux = [q0];
	est_final_nd = qf;
	delta_nd = d	
	}
	in
	determinise nda;;


let aut4 = glushkov e;;	

reconnait aut4 (list_of_string "bcabbcb");;

delta_etoile aut4 aut4.initial (list_of_string "abcab");;


	



let rec est_prefixe u m =
	match u,m with
		[],_ -> true
		|_,[] -> false
		|a::q,b::r -> a=b && est_prefixe q r;;

	
let bordure u = 
	let rec aux s =
		if est_prefixe s u then s else aux (List.tl s)
	in
	aux (List.tl u);;	
	
bordure ['b';'a';'b';'a';'b'];;

		

let aut_occ m = 
	let d p a = 
		let pa = p@[a] in
		if est_prefixe pa m then pa
		else bordure pa
	in
	let f p = p = m in
	{initial = [];
	est_final = f;
	delta = d}
	;;
	
	
let aut = aut_occ (list_of_string "abcaba");;

	
reconnait aut (list_of_string "hgihofdabcaba");;