Online Users:1 Access Number:883

CCALDAS @nline

Home > Algoritmo > Pascal

Reconhecedor de expressão regular

Este programa cria um reconhecedor de expressão regular através de autômatos. Este programa é composto pelo arquivo principal Automato.dpr e por 4 arquivos de unidade: uAutomato.pas, uConstante.pas, uConversor.pas e uEstado.pas

Automato.dpr

{
UFBA - Universidade Federal da Bahia
Disciplina Formais, Professora: Aline
Aluno:	Carlos Castelo Branco Caldas Neto, Matricula 200210613
Data: 21/06/2005
Objetivo:
	Fazer um programa para
   1: Converter uma expressao regular em automato finito pelo Método de Thompson
   2: Verficar se dada palavra da linguagem e aceita pelo automato
}

program Automato;
{$APPTYPE CONSOLE}
uses
  SysUtils,
  Classes,
  uAutomato in 'uAutomato.pas',
  uConstante in 'uConstante.pas',
  uEstado in 'uEstado.pas',
  uConversor in 'uConversor.pas';

var
	CaminhoArq : string;
	Arq : TextFile;
   strAlfabeto, strExpReg: string;
	Palavra: string;

   Conv : TConversor;
	A : TAutomato;
begin
	{Abre o arquivo}
	CaminhoArq := PegarCaminhoArquivo(ParamStr(1));
   AssignFile(Arq, CaminhoArq);
   Reset(Arq);
   {-------------------------------}
   ReadLn(Arq, strAlfabeto);
   strAlfabeto := StringReplace(strAlfabeto, ' ', '', [rfReplaceAll, rfIgnoreCase]);
   ReadLn(Arq, strExpReg);

   Conv := TConversor.Create;
   A := Conv.GerarAutomato(strExpReg,strAlfabeto);
   Conv.Destroy;
   WriteLn('-----------------------------------');
   WriteLn('Expressao Regular: ', strExpReg);
   A.ImprimirEstrutura;
   {-------------------------------}
   WriteLn('-----------------------------------');
   WriteLn('Palavras Testadas            Valida');
   Palavra := '';
   while (not EOF(Arq)) do begin
      ReadLn(Arq, Palavra);
      if Palavra = '$' then break;

      if A.ReconherPalavra(Palavra) then
      	WriteLn(Palavra, Espaco(30-Length(Palavra)),'(S)')
      else
      	WriteLn(Palavra, Espaco(30-Length(Palavra)),'(N)');
   end;
   ReadLn(strAlfabeto);
   {-------------------------------}
  	CloseFile(Arq);
   A.Destroy(True);
end.

uAutomato.pas

unit uAutomato;

interface
	uses uConstante, uEstado;
	type
		TAutomato = class
   		private
         	FAlfabeto : string;
         public
           	Estado_Inicio, Estado_Fim: TEstado;
				property Alfabeto: string read FAlfabeto;
            procedure ImprimirEstrutura;
				function ReconherPalavra(Palavra : string):boolean;
            {Metodos de Classe}
            constructor Create(const strAlfabeto:string); overload;
            constructor Create(const Simbolo:Char; const strAlfabeto:string; Estado_Fosso:TEstado);overload;
            destructor Destroy(DestruirEstado:Boolean=False);overload;

            class function CriarFlecho(A1: TAutomato):TAutomato;
            class function Somar(A1, A2: TAutomato):TAutomato;
            class function Concatenar(A1, A2 : TAutomato):TAutomato;
         end;

implementation

{ TAutomato }

{Cria o Automato Primario}
constructor TAutomato.Create(const strAlfabeto:string);
begin
	FAlfabeto := strAlfabeto;
   Self.Estado_Inicio := nil;
   Self.Estado_Fim := nil;
end;

{Cria um automato base}
constructor TAutomato.Create(const Simbolo: Char; const strAlfabeto: string;
  Estado_Fosso: TEstado);
var
	E1, E2: TEstado;
begin
	Self.FAlfabeto := strAlfabeto;
   E2 := TEstado.Create(True);

   if Simbolo = cntLambda then
   	E1 := E2
   else begin
		E1 := TEstado.Create;

		if Simbolo <> cntConjVazio then
		  	E1.AdicionarTransicao(Simbolo, E2);
	end;

   Self.Estado_Inicio := E1;
   Self.Estado_Fim := E2;
end;

destructor TAutomato.Destroy(DestruirEstado: Boolean);
begin
	
end;

{-----------------------------------------------------------------------------}

class function TAutomato.Concatenar(A1, A2: TAutomato): TAutomato;
begin
   A1.Estado_Fim.EstadoFinal := False;
   A1.Estado_Fim.AdicionarTransicao(cntLambda, A2.Estado_Inicio);
   A1.Estado_Fim := A2.Estado_Fim;
   A2.Destroy(False);
   Result := A1;
end;

class function TAutomato.CriarFlecho(A1: TAutomato): TAutomato;
begin
	A1.Estado_Inicio.AdicionarTransicao(cntLambda, A1.Estado_Fim);
   A1.Estado_Fim.AdicionarTransicao(cntLambda, A1.Estado_Inicio);
   Result := A1;
end;

class function TAutomato.Somar(A1, A2: TAutomato): TAutomato;
var
	Inicio, Fim : TEstado;
begin
   A1.Estado_Fim.EstadoFinal := False;
   A2.Estado_Fim.EstadoFinal := False;

	Inicio := TEstado.Create;
   Fim := TEstado.Create(True);

	Inicio.AdicionarTransicao(cntLambda, A1.Estado_Inicio);
	Inicio.AdicionarTransicao(cntLambda, A2.Estado_Inicio);

   A1.Estado_Fim.AdicionarTransicao(cntLambda, Fim);
   A2.Estado_Fim.AdicionarTransicao(cntLambda, Fim);

   A2.Destroy(False);

	A1.Estado_Inicio := Inicio;
   A1.Estado_Fim := Fim;
   Result := A1;
end;

{-----------------------------------------------------------------------------}

procedure TAutomato.ImprimirEstrutura;
var
   arrEstado : TarrEstado;
	{A 1a dimensao representa os estados
   A 2a dimensao representa os simbolos
   A 3a dimensao que e o vetor TarrEstado representa o resultado da funcao}
	arrEstadoDestino: array of array of TarrEstado;
   i,j,k : integer;
   simbolos : string;
   tmp : TarrEstado;
begin
   WriteLn('-----------------------------------');
	WriteLn('Dados Automato:');
	Writeln('-Simbolo Lambda = ', cntLambda);
	Writeln('-Alfabeto = ', Self.Alfabeto);
	Writeln('-Estado Inicial = ', Self.Estado_Inicio.Nome);
	Writeln('-Estado Final = ', Self.Estado_Fim.Nome);
   WriteLn('-----------------------------------');

   WriteLn('Estado     Simbolo>Estado');

	simbolos := Alfabeto + cntLambda;
	SetLength(arrEstado,0);
	SetLength(tmp,0);
   Self.Estado_Inicio.Fecho(arrEstado, False);

   SetLength(arrEstadoDestino, Length(arrEstado));
   for i := Low(arrEstado) to High(arrEstado) do
   	SetLength(arrEstadoDestino[i], Length(simbolos));

	for j := Low(arrEstado) to High(arrEstado) do
   	for i := Low(arrEstadoDestino[j]) to High(arrEstadoDestino[j]) do begin
         	tmp := arrEstado[j].TransicaoDireta(simbolos[i+1]); //O vetor comeca de zero e a string de 1
//				tmp := arrEstado[j].TransicaoTudo(simbolos[i+1], False);
	      	arrEstadoDestino[j][i] := tmp;
      end;

   for j := Low(arrEstado) to High(arrEstado) do begin
   	write(arrEstado[j].Nome,':        ');
   	for i := Low(arrEstadoDestino[j]) to High(arrEstadoDestino[j]) do begin
      	for k := Low(arrEstadoDestino[j][i]) to High(arrEstadoDestino[j][i]) do begin
         	write(simbolos[i+1], '>', arrEstadoDestino[j][i][k].Nome, '  ');
         end;
      end;
      WriteLn;
   end;
end;

function TAutomato.ReconherPalavra(Palavra: string): boolean;
var
	arr : TarrEstado;
   i : integer;
begin
	Result := False;
	Self.Estado_Inicio.TransicaoExtendida(Palavra, arr);
   for i:= Low(arr) to High(arr) do
   	if arr[i].EstadoFinal then begin
      	Result := True;
         Exit;
	   end;
end;

end.

uConstante.pas

unit uConstante;

interface
	const
   	cntLambda = 'y';
      cntConjVazio = 'V';
      cntOperador = '+.*';

   function strUniao(Str1, Str2:string):string;
	function PegarCaminhoArquivo(const Arq:string):string;
   function espaco(Tamanho:integer):string;

implementation

uses SysUtils;

function strUniao(Str1, Str2:string):string;
var
	C : Char;
begin
	while Str1 <> '' do begin
   	C := Str1[1];
      Delete(Str1,1,1);
      if Pos(C, Str2) <= 0 then
      	Insert(C, Str2, 1);
   end;
   Result := Str2;
end;

function PegarCaminhoArquivo(const Arq:string):string;
var
	str : string;
begin
	str := Arq;
	while not FileExists(str) do begin
   	WriteLn('Informe o arquivo de entrada:');
      ReadLn(str);
   end;
   Result := str;
end;

function espaco(Tamanho:integer):string;
begin
   Result := '';
	while Length(Result) < Tamanho do
   	Result := Result + ' ';
end;

end.

uConversor

{
A Expressao Regular Segue o Seguinte Padrao
Expressao = (Base[+Bse][.Base])
Base = Simbolo ou Expressao

Esta sendo calculado usando um algoritimo recursivo descendente
}
unit uConversor;

interface
	uses uAutomato;
	type
   	TConversor = class
      	private
         	AutMestre : TAutomato;
            iProxToken : integer;
            ExpReg : string;
            procedure ExpReg_GerarErro();
            function ExpReg_ProximoToken: char;
            function ExpReg_RetBase:TAutomato;
            function ExpReg_RetExpressao: TAutomato;
			public
            function GerarAutomato(const ExpReg, Alfabeto:string):TAutomato;
            destructor Destroy;override;
      end;
implementation

uses SysUtils, uConstante;

{ TConversor }

destructor TConversor.Destroy;
begin
	AutMestre.Destroy(False);
   inherited;
end;

procedure TConversor.ExpReg_GerarErro;
begin
//	raise Exception.CreateFmt('A expressão "%s" não é uma expressão válida',[ExpReg]);
	WriteLn('A expressao "' + ExpReg + '" nao e valida');
   Halt;
end;

function TConversor.ExpReg_ProximoToken : char;
begin
	Inc(iProxToken);
   while ExpReg[iProxToken] = ' ' do Inc(iProxToken);
   Result := ExpReg[iProxToken];
end;

function TConversor.ExpReg_RetBase: TAutomato;
var
	t : char;
begin
	t := ExpReg_ProximoToken;
   if t in['(',')'] then Dec(iProxToken);
   if (Pos(t, AutMestre.Alfabeto) > 0) or ( t in [cntLambda, cntConjVazio] ) then
	 	Result := TAutomato.Create(t, AutMestre.Alfabeto, nil{AutMestre.Estado_Fosso})
   else
   	Result := ExpReg_RetExpressao;
end;

function TConversor.ExpReg_RetExpressao: TAutomato;
var
	token,op: char;
   A1,A2,Resp:TAutomato;
begin
	Resp := nil;
	token := ExpReg_ProximoToken();//primeiro parentese
   if token <> '(' then ExpReg_GerarErro();
   A1 := ExpReg_RetBase();
   op := ExpReg_ProximoToken(); //operador;
   if Pos(op, cntOperador) <= 0 then ExpReg_GerarErro();
   if op = '*' then A2 := nil else A2 := ExpReg_RetBase();  //Asterisco (*) é o único operador unário
	case op of
		'+': Resp := TAutomato.Somar(A1,A2);
      '.': Resp := TAutomato.Concatenar(A1,A2);
      '*': Resp := TAutomato.CriarFlecho(A1);
   end;
   token := ExpReg_ProximoToken();//segundo parentese
   if token <> ')' then ExpReg_GerarErro();
   Result := Resp;
end;

function TConversor.GerarAutomato(const ExpReg,
  Alfabeto: string): TAutomato;
begin
   Self.iProxToken := 0;
	Self.ExpReg := ExpReg;
   Self.AutMestre := TAutomato.Create(Alfabeto);
	Result := ExpReg_RetBase();
	if iProxToken < Length(ExpReg) then ExpReg_GerarErro();
end;

end.

uEstado.pas

unit uEstado;

interface
	type
   	TEstado = class;
      TarrEstado = array of TEstado;
      TarrTransicao = array of record
	   	conjSimbolo : String;
		   IrPara : TEstado;
      end;

      TEstado = class
			private
         	arrTransicao : TarrTransicao;
			public
         	Nome : string;
            EstadoFinal : Boolean;
            procedure AdicionarTransicao(const conjSimbolo:String; Estado: TEstado);

				{Funcoes de Transicao}
            procedure Fecho(var arrEstado:TArrEstado;LambdaFecho:Boolean);
//            function TransicaoTudo(const Simbolo:char; Lambda : Boolean):TarrEstado;
            function TransicaoDireta(const Simbolo : char):TarrEstado;
            procedure TransicaoComLambda(const Simbolo: char; var arrEstado:TarrEstado);
            procedure TransicaoExtendida(const Palavra:string; var arrEstado:TarrEstado);

            {Metodos de Classe}
            constructor Create(Final:Boolean = False);
            class function UnirVetorEstado(const A1,A2:TarrEstado):TarrEstado;
            class function Procurar(var A:TarrEstado;E :TEstado):integer;
      end;

implementation

uses uConstante,SysUtils;
var
	ContEstado : Integer;

{ TEstado }

procedure TEstado.AdicionarTransicao(const conjSimbolo:string;
  Estado: TEstado);
var
	Tam, i : Integer;
begin
	for i:= Low(arrTransicao) to High(arrTransicao) do
   	if arrTransicao[i].IrPara = Estado then begin
         arrTransicao[i].conjSimbolo := strUniao(arrTransicao[i].conjSimbolo, conjSimbolo);
         Exit;
	   end;

	Tam := High(arrTransicao)+1;
   if Tam < 0 then Tam := 0;
   SetLength(arrTransicao, Tam+1);
	arrTransicao[Tam].conjSimbolo := conjSimbolo;
	arrTransicao[Tam].IrPara := Estado;
end;

{function TEstado.TransicaoTudo(const Simbolo: char; Lambda : Boolean): TarrEstado;
var
	vet, Resp : TarrEstado;
   i,j : Integer;
begin
	if Lambda then
		Self.Fecho(vet, True)
   else begin
   	SetLength(vet, 1);
      vet[0] := Self;
   end;

  	SetLength(Resp,0);
   for i:= Low(vet) to High(vet) do
   	for j := Low(vet[i].arrTransicao) to High(vet[i].arrTransicao) do
	      if Pos(Simbolo, arrTransicao[i].conjSimbolo) > 0 then
         	if Self.Procurar(Resp, arrTransicao[i].IrPara) < 0 then begin
	   	   	SetLength(Resp,High(Resp)+2);
		      	Resp[High(Resp)] := arrTransicao[i].IrPara;
            end;

   if Lambda then
	   for i := Low(Resp) to High(Resp) do begin
			Resp[i].Fecho(vet, True);
	      Resp := TEstado.UnirVetorEstado(Resp, vet);
	   end;
   Result := Resp;
end;}

function TEstado.TransicaoDireta(const Simbolo : char): TarrEstado;
var
	Resp : TarrEstado;
   i : Integer;
begin
	SetLength(Resp,0);
	for i:= Low(arrTransicao) to High(arrTransicao) do begin
      if Pos(Simbolo, arrTransicao[i].conjSimbolo) > 0 then begin
      	SetLength(Resp,High(Resp)+2);
      	Resp[High(Resp)] := arrTransicao[i].IrPara;
      end;
   end;
   Result := Resp;
end;

procedure TEstado.TransicaoComLambda(const Simbolo: char;
  var arrEstado: TarrEstado);
var
	arrLFecho, arrTransicaoSimb, Tmp, R : TarrEstado;
   i : integer;
begin
	SetLength(arrLFecho,0);
   SetLength(arrTransicaoSimb,0);
   SetLength(R,0);

	Self.Fecho(arrLFecho,True);
   for i := Low(arrLFecho) to High(arrLFecho) do begin
      Tmp := arrLFecho[i].TransicaoDireta(Simbolo);
   	arrTransicaoSimb := TEstado.UnirVetorEstado(arrTransicaoSimb, Tmp);
   end;

   for i := Low(arrTransicaoSimb) to High(arrTransicaoSimb) do begin
		arrTransicaoSimb[i].Fecho(Tmp, True);
      R := TEstado.UnirVetorEstado(R, Tmp);
   end;
   arrEstado := R;
end;

constructor TEstado.Create(Final: Boolean);
begin
	EstadoFinal := Final;
   SetLength(arrTransicao,0);
   Inc(ContEstado);
   Self.Nome := 'Q'+IntToStr(ContEstado);
end;

class function TEstado.UnirVetorEstado(const A1, A2: TarrEstado): TarrEstado;
var
	i,Achados1, Achados2 : integer;
   tmp : TarrEstado;
begin
	SetLength(tmp, High(A1)+High(A2)+2);
   for i := Low(Tmp) to High(Tmp) do
   	Tmp[i] := nil;

	Achados1 := 0;
   for i := Low(A1) to High(A1) do
	   if Self.Procurar(Tmp,A1[i]) < 0 then begin
			tmp[Achados1] := A1[i];
         Inc(Achados1);
      end;

   Achados2 := 0;
   for i := low(A2) to high(A2) do
      if Self.Procurar(Tmp,A2[i]) < 0 then begin
			tmp[Achados1+Achados2] := A2[i];
         Inc(Achados2);
      end;
   SetLength(Tmp, Achados1+Achados2);
   Result := tmp;
end;

procedure TEstado.Fecho(var arrEstado: TArrEstado; LambdaFecho:Boolean);
var
	i : Integer;
   Tmp : TarrEstado;
   Entrar : Boolean;
begin
	SetLength(Tmp, 1);
   Tmp[0] := Self;
	arrEstado := TEstado.UnirVetorEstado(arrEstado,Tmp);
	for i := Low(arrTransicao) to High(arrTransicao) do begin
		if TEstado.Procurar(arrEstado, arrTransicao[i].IrPara) < 0 then begin
			Entrar := True;
      	if LambdaFecho then
         	Entrar := (Pos(cntLambda, Self.arrTransicao[i].conjSimbolo) > 0);
         if Entrar then
	      	arrTransicao[i].IrPara.Fecho(arrEstado, LambdaFecho);
	   end;
   end;
end;

class function TEstado.Procurar(var A:TarrEstado;E :TEstado):integer;
var
	i : integer;
begin
	result := -1;
	for i := Low(A) to High(a) do begin
      if (a[i] = nil) then
      	break
      else
         if (a[i] = E) then begin
            Result := i;
            break;
         end;
   end;
end;

procedure TEstado.TransicaoExtendida(const Palavra: string;
  var arrEstado: TarrEstado);

procedure processar(const Conj : TarrEstado; Palavra:string; var saida:TarrEstado);
var
	i: integer;
   Tmp, R: TarrEstado;
begin
	if Palavra='' then begin
      saida := Conj;
   	exit;
   end;
   SetLength(R,0);
   for i:= Low(Conj) to High(Conj) do begin
	 	Conj[i].TransicaoComLambda(Palavra[1], Tmp);
//		Tmp := Conj[i].TransicaoTudo(Palavra[1],True);
      R := TEstado.UnirVetorEstado(R, Tmp);
  	end;

  	Delete(Palavra,1,1);
   processar(R, Palavra, saida)
end;

var
	Tmp : TarrEstado;
   str : string;
begin
   Self.TransicaoComLambda(Palavra[1], Tmp);
//	Tmp := Self.TransicaoTudo(Palavra[1],True);
	str := Palavra;
   Delete(str,1,1);
	processar(Tmp, str, arrEstado);
end;


initialization
	ContEstado := 0;
end.
Valid XHTML 1.0 Transitional Get Opera Valid CSS!