127 lines
3.0 KiB
OCaml
127 lines
3.0 KiB
OCaml
type expr_rat =
|
|
Vide
|
|
| Epsilon
|
|
| Lettre of char
|
|
| Concat of expr_rat * expr_rat
|
|
| Plus of expr_rat * expr_rat
|
|
| Etoile of expr_rat;;
|
|
|
|
type expr_lin =
|
|
Empty
|
|
| Epsi
|
|
| Pos of int
|
|
| Prod of expr_lin * expr_lin
|
|
| Sum of expr_lin * expr_lin
|
|
| Star of expr_lin;;
|
|
|
|
|
|
|
|
|
|
let exemplE = Concat(Etoile(Plus(Lettre('a'),Concat(Lettre('a'),Lettre('b')))),Concat(Lettre('a'),Lettre('b')));;
|
|
|
|
let rec litotabi l arr i = match l with
|
|
| [] -> ()
|
|
| e::s -> arr.((Array.length arr)-i-1) <- e;
|
|
litotabi s arr (i+1);;
|
|
let linearise erat =
|
|
let rec ratisse erat i s= match erat with
|
|
| Vide -> (Empty,i,s)
|
|
| Epsilon -> (Epsi,i,s)
|
|
| Lettre(c) -> (Pos(i),i+1,c::s)
|
|
| Concat(e,f) ->
|
|
let (el1,i1,s1) = ratisse e i s in
|
|
let (el2,i2,s2) = ratisse f i1 s1 in
|
|
(Prod(el1,el2),i2,s2)
|
|
| Plus(e,f) ->
|
|
let (el1,i1,s1) = ratisse e i s in
|
|
let (el2,i2,s2) = ratisse f i1 s1 in
|
|
(Sum(el1,el2),i2,s2)
|
|
| Etoile(e) ->
|
|
let (el,ii,ss) = ratisse e i s in
|
|
(Star(el),ii,ss)
|
|
in let (elin,ii,ss) = ratisse erat 1 [] in
|
|
let assoc = Array.make (ii) ' ' in
|
|
litotabi ss assoc 0;
|
|
(elin,assoc)
|
|
;;
|
|
|
|
let rec accepteMotVide elin = match elin with
|
|
| Empty -> false
|
|
| Epsi -> true
|
|
| Pos(i) -> false
|
|
| Prod(e,f) -> (accepteMotVide e) && (accepteMotVide f)
|
|
| Sum(e,f) -> (accepteMotVide e) || (accepteMotVide f)
|
|
| Star(e) -> true;;
|
|
|
|
let rec prefixes elin = match elin with
|
|
| Empty -> []
|
|
| Epsi -> []
|
|
| Pos(i) -> [i]
|
|
| Prod(e,f) ->
|
|
if accepteMotVide e
|
|
then (prefixes e)@(prefixes f)
|
|
else (prefixes e)
|
|
| Sum(e,f) -> (prefixes e)@(prefixes f)
|
|
| Star(e) -> (prefixes e);;
|
|
let rec suffixes elin = match elin with
|
|
| Empty -> []
|
|
| Epsi -> []
|
|
| Pos(i) -> [i]
|
|
| Prod(e,f) ->
|
|
if accepteMotVide f
|
|
then (suffixes e)@(suffixes f)
|
|
else (suffixes f)
|
|
| Sum(e,f) -> (suffixes e)@(suffixes f)
|
|
| Star(e) -> (suffixes e);;
|
|
let rec suivant elin i = match elin with
|
|
| Empty -> []
|
|
| Epsi -> []
|
|
| Pos(p) -> []
|
|
| Prod(e,f) -> let ss1,ss2 = (suivant e i,suivant f i) in
|
|
let s1 = suffixes e and p2 = prefixes f in
|
|
if (List.mem i s1)
|
|
then ss1@p2@ss2
|
|
else ss1@ss2
|
|
| Sum(e,f) -> (suivant e i)@(suivant f i)
|
|
| Star(e) -> let ss = suivant e i
|
|
and p = prefixes e
|
|
and s = suffixes e in
|
|
if (List.mem i s)
|
|
then ss@p
|
|
else ss;;
|
|
|
|
type automate = {nb_etat:int;finaux:int list;transitions:((char*int) list) array};;
|
|
|
|
let transi elin assoc =
|
|
let rec transii ss assoc s = match ss with
|
|
| [] -> s
|
|
| j::ff -> transii ff assoc (((assoc.(j),j))::s)
|
|
in let n = Array.length assoc in
|
|
let out = Array.make n [] in
|
|
for i=1 to (n-1) do
|
|
out.(i) <- transii (suivant elin i) assoc []
|
|
done;
|
|
out.(0) <- transii (prefixes elin) assoc [];
|
|
out;;
|
|
|
|
let glushkov erat =
|
|
let elin,assoc = linearise erat in
|
|
let s = suffixes elin in
|
|
let momo = accepteMotVide elin in
|
|
let netats = Array.length assoc in
|
|
let transitions = transi elin assoc in
|
|
let fino = if momo then 0::s else s in
|
|
{nb_etat=netats;finaux=fino;transitions=transitions};;
|
|
|
|
let estAccepte
|
|
|
|
let (el,ccccccc) = linearise exemplE;;
|
|
accepteMotVide el;;
|
|
prefixes el;;
|
|
suffixes el;;
|
|
suivant el 1;;
|
|
glushkov exemplE;;
|
|
|
|
|
|
|