Построение распознавателя для заданной грамматики и реализация его в виде программы которая проверяет (стр. 4 из 4)

Список литературы

1. Новиков Ф.А. Дискретная математика для программистов. - СПб: Питер, 2005. - 304с.

2. Иванов Б.Н. Дискретная математика. Алгоритмы и программы: Учеб. пособие. - М.: Лаборатория Базовых Знаний, 2002. - 288с.

3. Яблонский С.В. Введение в дискретную математику: Учеб. пособие для вузов. - 2-е изд., перераб. и доп. - М.: Наука, 1996 - 384с.

4. Бардачов Ю.М. та ін. Дискретна математика: Підручник / За ред.В. Є. Ходакова. - К.: Вища шк., 2002. -287с.

5. Системное программное обеспечение / А.В. Гордеев, А.Ю. Молчанов. - СПб.: Питер, 2004. - 736с.

6. Кузнецов О.П., Адельсон-Вельский Г.М. Дискретная математика для инженера. - М: Энергоатомиздат, 1998. - 480 с.

7. Горбатов В.А. Основы дискретной математики. - М.: Высш. школа, 2001. - 324с.

Приложение

unitUnit2;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, Buttons, ExtCtrls, Menus;

type

TForm2 = class (TForm)

ListBox1: TListBox;

Label1: TLabel;

Bevel1: TBevel;

Label2: TLabel;

Edit2: TEdit;

BitBtn1: TBitBtn;

BitBtn2: TBitBtn;

BitBtn3: TBitBtn;

ComboBox1: TComboBox;

MainMenu1: TMainMenu;

N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

Bevel2: TBevel;

BitBtn4: TBitBtn;

OpenDialog1: TOpenDialog;

SaveDialog1: TSaveDialog;

Bevel3: TBevel;

Label3: TLabel;

procedure BitBtn3Click (Sender: TObject);

procedure BitBtn1Click (Sender: TObject);

procedure BitBtn2Click (Sender: TObject);

procedure N3Click (Sender: TObject);

procedure N4Click (Sender: TObject);

procedure N1Click (Sender: TObject);

procedure N2Click (Sender: TObject);

procedure BitBtn4Click (Sender: TObject);

procedure FormActivate (Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form2: TForm2;

var

i_max,j_max: byte;

const

Neterminal: set of byte = [65. .90] ;

Terminal: set of byte = [97. .122] ;

implementation

uses Unit1, Unit3, Unit4;

{$R *. DFM}

Function DigitToCode (i: integer; osn: byte): String;

var

s,ss,last: string;

j: integer;

Begin

ss: ='';

while i div osn > 0 do

begin

str ( (i mod osn),s);

ss: =ss+s;

i: =i div osn;

end;

str (i,s);

ss: =ss+s;

for j: =length (ss) downto 1 do last: =last+ss [j] ;

DigitToCode: =last;

End;

procedure TForm2. BitBtn3Click (Sender: TObject);

label Again, Again1, Again2, Again3, Return;

var

i: byte;

kol: byte;

i_tmp,j_tmp: byte;

s: string;

j,k,l: longint;

code: integer;

osn,num,p_ins: byte;

posled,chain,tmp: string;

let: char;

mn: set of char;

flag: boolean;

kk,kol_op: longword;

f: byte;

begin

if ListBox1. Items. Count=0 then

begin

MessageDlg ('Не введены правила грамматики. '+#13+'Введите правила. ',mtError, [mbOk],0);

exit;

end;

mn: = [] ;

for i: =0 to ListBox1. Items. Count-1 do

begin

flag: =True;

for j: =5 to length (ListBox1. Items. Strings [i]) do

if not (ord (ListBox1. Items. Strings [i] [j]) in Terminal) then flag: =False;

if flag then mn: =mn+ [ListBox1. Items. Strings [i] [1]] ;

end;

Again:

for i: =0 to ListBox1. Items. Count-1 do

begin

flag: =False;

for j: =5 to length (ListBox1. Items. Strings [i]) do

begin

if (ord (ListBox1. Items. Strings [i] [j]) in Neterminal) and

(ListBox1. Items. Strings [i] [j] in mn) and

(not (ListBox1. Items. Strings [i] [1] in mn)) then flag: =True;

end;

if flag then

begin

mn: =mn+ [ListBox1. Items. Strings [i] [1]] ;

goto Again;

end;

s: ='';

for i: =0 to ListBox1. Items. Count-1 do

if (not (ListBox1. Items. Strings [i] [1] in mn)) and

(Pos (ListBox1. Items. Strings [i] [1],s) =0) then s: =s+ListBox1. Items. Strings [i] [1] +' ';

if s<>'' then

begin

if length (s) >2 then MessageDlg ('Нетерминалы '+s+'непродуктивны. '+#13+'Все правила, их содержащие, будут удалены из грамматики. ',mtInformation, [mbOk],0)

else MessageDlg ('Нетерминал '+s+'непродуктивен. '+#13+'Все правила, его содержащие, будут удалены из грамматики. ',mtInformation, [mbOk],0);

Again1:

if ListBox1. Items. Count<>0 then

begin

for i: =0 to ListBox1. Items. Count-1 do

for j: =1 to length (ListBox1. Items. Strings [i]) do

if (ord (ListBox1. Items. Strings [i] [j]) in Neterminal) and

(not (ListBox1. Items. Strings [i] [j] in mn)) then

begin

ListBox1. Items. Delete (i);

goto Again1;

end;

end

else

begin

MessageDlg ('Все правила были удалены из грамматики. '+#13+'Введите новые правила. ',mtInformation, [mbOk],0);

BitBtn2. Enabled: =False;

exit;

end

end;

flag: =False;

for i: =0 to ListBox1. Items. Count-1 do

begin

if ListBox1. Items. Strings [i] [1] ='S' then flag: =True;

end;

if not flag then

begin

MessageDlg ('Во введенной грамматике нет правила, содержащего '+#13+'в левой части начальный символ грамматики S. '+#13+'Необходимо добавить такое правило. ',mtError, [mbOk],0);

ComboBox1. SetFocus;

exit;

end;

mn: = ['S'] ;

Again2:

for i: =0 to ListBox1. Items. Count-1 do

begin

if ListBox1. Items. Strings [i] [1] in mn then

begin

for j: =5 to length (ListBox1. Items. Strings [i]) do

begin

if (ord (ListBox1. Items. Strings [i] [j]) in Neterminal) and

(not (ListBox1. Items. Strings [i] [j] in mn)) then

begin

mn: =mn+ [ListBox1. Items. Strings [i] [j]] ;

goto Again2;

end;

s: ='';

for i: =0 to ListBox1. Items. Count-1 do

if (not (ListBox1. Items. Strings [i] [1] in mn)) and

(Pos (ListBox1. Items. Strings [i] [1],s) =0) then s: =s+ListBox1. Items. Strings [i] [1] +' ';

if s<>'' then

begin

if length (s) >2 then MessageDlg ('Нетерминалы '+s+'недостижимы. '+#13+'Все правила, их содержащие, будут удалены из грамматики. ',mtInformation, [mbOk],0)

else MessageDlg ('Нетерминал '+s+'недостижим. '+#13+'Все правила, его содержащие, будут удалены из грамматики. ',mtInformation, [mbOk],0);

Again3:

if ListBox1. Items. Count<>0 then

begin

for i: =0 to ListBox1. Items. Count-1 do

for j: =1 to length (ListBox1. Items. Strings [i]) do

if (ord (ListBox1. Items. Strings [i] [j]) in Neterminal) and

(not (ListBox1. Items. Strings [i] [j] in mn)) then

begin

ListBox1. Items. Delete (i);

goto Again3;

end;

end

else

begin

MessageDlg ('Все правила были удалены из грамматики. '+#13+'Введите новые правила. ',mtInformation, [mbOk],0);

BitBtn2. Enabled: =False;

exit;

end

end;

alfavit: = [] ;

end;

for i: =1 to length (Right) do

begin

if not (ord (Right [i]) in Neterminal) and not (ord (Right [i]) in Terminal) then

begin

ErrFlag: =True;

goto ErrorMsgRight;

end;

if length (Right) <>1 then

begin

for i: =1 to length (Right) do

if Right [i] ='e' then Delete (Right, i,1);

end;

ErrorMsgRight:

if ErrFlag then

begin

MessageDlg ('Ошибка в правой части правила',mtError, [mbOk],0);

Edit2. SetFocus;

exit;

end;

if not (ord (Right [1]) in Terminal) then

begin

ErrFlag: =True;

goto ErrorQGram;

end;

if ListBox1. Items. Count>0 then

begin

for i: =0 to ListBox1. Items. Count-1 do

begin

if (ListBox1. Items. Strings [i] [1] =Left) and

(ListBox1. Items. Strings [i] [5] =Right [1]) then

begin

ErrFlag: =True;

break;

end;

ErrorQGram:

if ErrFlag then

begin

MessageDlg ('Это правило не может содержаться в q-грамматике',mtError, [mbOk],0);

Edit2. SetFocus;

exit;

end;

Rule: =Left+'-->'+Right;

ListBox1. Items. Add (Rule);

BitBtn4. Enabled: =True;

BitBtn3. Enabled: =False;

end;

procedure TForm2. BitBtn2Click (Sender: TObject);

var

i: byte;

begin

for i: =0 to ListBox1. Items. Count-1 do

begin

if ListBox1. Selected [i] then

begin

ListBox1. Items. Delete (i);

break;

end;

if ListBox1. Items. Count=0 then BitBtn2. Enabled: =False;

end;

procedure TForm2. N3Click (Sender: TObject);

begin

// winexec ('. \help.html',4);

Application. Helpcontext (10);

end;

procedure TForm2. N4Click (Sender: TObject);

begin

Form2. Close;

Form1. Close;

end;

procedure TForm2. N1Click (Sender: TObject);

begin

if OpenDialog1. Execute then

begin

ListBox1. Items. LoadFromFile (OpenDialog1. FileName);

end;

BitBtn4. Enabled: =True;

BitBtn3. Enabled: =False;

end;

procedure TForm2. N2Click (Sender: TObject);

begin

if SaveDialog1. Execute then

begin

ListBox1. Items. SaveToFile (SaveDialog1. FileName);

end;

procedure TForm2. BitBtn4Click (Sender: TObject);

Label Next,Again,Again1,Again2,Again3;

var

i,j: byte;

s: string;

mn: set of char;

flag: boolean;

begin

for i: =0 to ListBox1. Items. Count-2 do

begin

for j: =i+1 to ListBox1. Items. Count-1 do

begin

if (ListBox1. Items. Strings [i] [1] =ListBox1. Items. Strings [j] [1]) and

(ListBox1. Items. Strings [i] [5] =ListBox1. Items. Strings [j] [5]) then

begin

MessageDlg ('Правило '+ListBox1. Items. Strings [j] +' не может содержаться в q-грамматике. Оно будет удалено. ',mtInformation, [mbOk],0);

ListBox1. Items. Delete (j);

goto Next;

end;

mn: = [] ;

for i: =0 to ListBox1. Items. Count-1 do

begin

flag: =True;

for j: =5 to length (ListBox1. Items. Strings [i]) do

if not (ord (ListBox1. Items. Strings [i] [j]) in Terminal) then flag: =False;

if flag then mn: =mn+ [ListBox1. Items. Strings [i] [1]] ;

end;

Again:

for i: =0 to ListBox1. Items. Count-1 do

begin

flag: =False;

for j: =5 to length (ListBox1. Items. Strings [i]) do

begin

if (ord (ListBox1. Items. Strings [i] [j]) in Neterminal) and

(ListBox1. Items. Strings [i] [j] in mn) and

(not (ListBox1. Items. Strings [i] [1] in mn)) then flag: =True;

end;

if flag then

begin

mn: =mn+ [ListBox1. Items. Strings [i] [1]] ;

goto Again;

end;

s: ='';

for i: =0 to ListBox1. Items. Count-1 do

if (not (ListBox1. Items. Strings [i] [1] in mn)) and

(Pos (ListBox1. Items. Strings [i] [1],s) =0) then s: =s+ListBox1. Items. Strings [i] [1] +' ';

if s<>'' then

begin

Again1:

if ListBox1. Items. Count<>0 then

begin

for i: =0 to ListBox1. Items. Count-1 do

for j: =1 to length (ListBox1. Items. Strings [i]) do

if (ord (ListBox1. Items. Strings [i] [j]) in Neterminal) and

(not (ListBox1. Items. Strings [i] [j] in mn)) then

begin

ListBox1. Items. Delete (i);

goto Again1;

end;

end

else

begin

MessageDlg ('Все правила были удалены из грамматики. '+#13+'Введите новые правила. ',mtInformation, [mbOk],0);

BitBtn2. Enabled: =False;

exit;

end

end;

flag: =False;

for i: =0 to ListBox1. Items. Count-1 do

begin

if ListBox1. Items. Strings [i] [1] ='S' then flag: =True;

end;

if not flag then

begin

ComboBox1. SetFocus;

exit;

end;

mn: = ['S'] ;

Again2:

for i: =0 to ListBox1. Items. Count-1 do

begin

if ListBox1. Items. Strings [i] [1] in mn then

begin

for j: =5 to length (ListBox1. Items. Strings [i]) do

begin

if (ord (ListBox1. Items. Strings [i] [j]) in Neterminal) and

(not (ListBox1. Items. Strings [i] [j] in mn)) then

begin

mn: =mn+ [ListBox1. Items. Strings [i] [j]] ;

goto Again2;

end;

s: ='';

for i: =0 to ListBox1. Items. Count-1 do

if (not (ListBox1. Items. Strings [i] [1] in mn)) and

(Pos (ListBox1. Items. Strings [i] [1],s) =0) then s: =s+ListBox1. Items. Strings [i] [1] +' ';

if s<>'' then

begin

Again3:

if ListBox1. Items. Count<>0 then

begin

for i: =0 to ListBox1. Items. Count-1 do

for j: =1 to length (ListBox1. Items. Strings [i]) do

if (ord (ListBox1. Items. Strings [i] [j]) in Neterminal) and

(not (ListBox1. Items. Strings [i] [j] in mn)) then

begin

ListBox1. Items. Delete (i);

goto Again3;

end;

end

else

begin

MessageDlg ('Все правила были удалены из грамматики. '+#13+'Введите новые правила. ',mtInformation, [mbOk],0);

BitBtn2. Enabled: =False;

exit;

end

end;

MessageDlg ('Эквивалентные преобразования грамматики завершены',mtInformation, [mbOk],0);

BitBtn3. Enabled: =True;

BitBtn4. Enabled: =False;

end;

procedure TForm2. FormActivate (Sender: TObject);

begin

BitBtn3. Enabled: =False;

end;

end.