Описание процедур. 
Построение эквивалентной праворекурсивной КС-грамматики

1) Анализ Входные данные: правила, введенные в Memo1.

Выходные данные: правила, выведенные в Memo2.

procedure TForm1. btn1Click (Sender: TObject);

label l;

BEGIN.

mmo2. Clear;

for i: =0 to mmo1. Lines. Count do.

if Length (mmo1. Lines [i]) >2 then begin.

mm: = []; s: =mmo1. Lines [i];

for j: =0 to Length (s) do begin.

if (s [j] in ['А'. 'Я']) or (s [j] in ['а'. 'я']) then mmo1. Lines. Delete (i);

mm: =mm+ [s [j]]; end;

if (not (s [1] in ['A'. 'Z'])) or (s [2] '-') or (' ' in mm) then mmo1. Lines. Delete (i);

end else mmo1. Lines. Delete (i);

for i: =0 to mmo1. Lines. Count do begin.

s: =mmo1. Lines [i];

n: =Pos ('/', s); Delete (s, n,1);

m: =Pos ('/', s); Delete (s, m,1);

if (n>0) and (m>0) and (n.

mmo2. Lines. Add (Copy (s, 1, n-1));

mmo2. Lines. Add (Copy (s, 1,2) +Copy (s, n, m-n));

mmo2. Lines. Add (Copy (s, 1,2) +Copy (s, m, Length (s) — m+1));

goto l;

end;

IF n>0 then begin.

mmo2. Lines. Add (Copy (s, 1, n-1));

mmo2. Lines. Add (Copy (s, 1,2) +Copy (s, n, Length (s) — n+1));

goto l;

end;

IF (n=0) and (Length (s) >2) then mmo2. Lines. Add (s);

l:

end;

for i: =0 to mmo2. Lines. Count do begin p [i]: =mmo2. Lines [i];

mn [i]: = [];

for j: =3 to Length (p [i]) do if p [i, j] in ['A'. 'Z'] then mn [i]: =mn [i] + [P [i, j]];

end;

END;

Пример выполнения:

Введем в Мемо1 следующие правила и нажмем на кнопку 1.

грамматика алгоритм символ правило.

2) Удаление бесплодных символов Входные данные: правила из Мемо2.

Выходные данные: правила в Мемо2 (без бесплодных символов).

procedure TForm1. btn2Click (Sender: TObject);

var vn2: set of Char;

begin.

v: =mmo2. Lines. Count;

for i: =0 to v do p [i]: ='';

for i: =0 to v do begin p [i]: =mmo2. Lines [i];

mn [i]: = [];

for j: =3 to Length (p [i]) do.

if p [i, j] in ['A'. 'Z'] then mn [i]: =mn [i] + [P [i, j]];

end;

mmo2. Clear;

vn: = [];

for i: =0 to v-1 do if mn [i] = [] then vn: =vn+ [p [i, 1]];

vn2: = [];

j: =0;

while vnvn2 do begin.

vn: =vn2;

for i: =0 to V-1 do.

if (mn [i] - vn= []).

then vn2: =vn2+vn+ [p [i, 1]];

end;

for i: =0 to v do.

for j: =1 to Length (p [i]) do.

if Length (p [i]) >2 then if (not (p [i, j] in vn)) and (p [i, j] in ['A'. 'Z']) then p [i]: ='';

for i: =0 to v do begin mn [i]: = [];

for j: =3 to Length (p [i]) do if p [i, j] in ['A'. 'Z'] then mn [i]: =mn [i] + [p [i, j]];

if Length (p [i]) >2 then mmo2. Lines. Add (p [i]);

end;

for i: =0 to v do p [i]: ='';

for i: =0 to mmo2. Lines. Count do begin p [i]: =mmo2. Lines [i];

mn [i]: = [];

for j: =3 to Length (p [i]) do.

if p [i, j] in ['A'. 'Z'] then mn [i]: =mn [i] + [P [i, j]];

end;

end;

Пример использования:

• 1. Введем в Мемо1 правила
• 2. Нажмем на кнопку 1
• 3. Нажмем на кнопку 1
• 3) Удаление недостижимых символов

Входные данные: правила из Мемо2.

Выходные данные: правила в Мемо2 (без недостижимых символов).

procedure TForm1. btn3Click (Sender: TObject);

begin.

v: =mmo2. Lines. Count;

for i: =0 to v do p [i]: ='';

for i: =0 to v do begin p [i]: =mmo2. Lines [i];

mn [i]: = [];

for j: =3 to Length (p [i]) do.

if p [i, j] in ['A'. 'Z'] then mn [i]: =mn [i] + [P [i, j]];

end;

mmo2. Clear;

vn: = [];

for i: =0 to 3 do.

if Length (p [i]) >1 then begin vn: =vn+ [p [i, 1]] +mn [0]; Break; end;

m: =0;

while m<4 do begin.

for i: =0 to v do.

if Length (p [i]) >2 then.

if p [i, 1] in vn then vn: =vn+mn [i];

Inc (m);

end;

for i: =0 to v do.

for j: =0 to Length (p [i]) do.

if Length (p [i]) >2 then if (not (p [i, j] in vn)) and (p [i, j] in ['A'. 'Z']) then p [i]: ='';

for i: =0 to v do.

if Length (p [i]) >2 then mmo2. Lines. Add (p [i]);

for i: =0 to v do p [i]: ='';

for i: =0 to mmo2. Lines. Count do begin p [i]: =mmo2. Lines [i];

mn [i]: = [];

for j: =3 to Length (p [i]) do.

if p [i, j] in ['A'. 'Z'] then mn [i]: =mn [i] + [P [i, j]];

end;

end;

Пример использования:

• 1. Введем правила в Мемо1
• 2. Нажмем на кнопку 1
• 3. Нажмем на кнопку 3
• 4) Устранение правил с пустой правой частью

Входные данные: правила из Мемо2.

Выходные данные: правила в Мемо2.

procedure TForm1. btn4Click (Sender: TObject);

begin.

v: =mmo2. Lines. Count;

for i: =0 to v do p [i]: ='';

for i: =0 to v do begin p [i]: =mmo2. Lines [i];

mn [i]: = [];

for j: =3 to Length (p [i]) do.

if p [i, j] in ['A'. 'Z'] then mn [i]: =mn [i] + [P [i, j]];

end;

mmo2. Clear;

j: =0;

for i: =0 to v do.

if Length (p [i]) >2 then.

if p [i, 3] ='e' then begin.

Inc (j); r [j]: =p [i, 1]; p [i]: ='';

end;

n: =j; k: =0;

for i: =1 to n do.

for j: =0 to v do begin.

if Length (p [j]) >1 then.

if r [i] in mn [j] then begin.

s: =p [j];

Delete (s, 1,2);

s1: =s;

m: =Pos (r [i], s);

delete (s, m,1);

l: =Pos (r [i], s);

if (m>0) and (l>0) then begin.

inc (k);

p [k+v]: =Copy (p [j], 1,2) +s;

Inc (k); l: =Pos (r [i], s); Delete (s1,l+1,1);

p [k+v]: =Copy (p [j], 1,2) +s1;

Inc (k); l: =Pos (r [i], s1); Delete (s1,l, 1);

p [k+v]: =Copy (p [j], 1,2) +s1;

end;

if (m>0) and (l=0) then begin.

inc (k);

p [k+v]: =Copy (p [j], 1,2) +s;

end;

end; end;

for i: =0 to v+ (k-1) do.

for j: =i+1 to v+k do begin.

if p [i] =p [j] then p [j]: ='';

if (Length (p [i]) =3) and (p [i, 1] =p [i, 3]) then p [i]: ='';

end;

for i: =0 to v+k do.

if Length (p [i]) >2 then mmo2. Lines. Add (p [i]);

for i: =0 to v do p [i]: ='';

for i: =0 to mmo2. Lines. Count do begin p [i]: =mmo2. Lines [i];

mn [i]: = [];

for j: =3 to Length (p [i]) do.

if p [i, j] in ['A'. 'Z'] then mn [i]: =mn [i] + [P [i, j]];

end;

end;

Пример использования:

• 1. Вводим правила в Мемо1
• 2. Нажимаем на кнопку 1
• 3. Нажимаем на кнопку 4
• 5) Исключение цепных правил

Входные данные: правила из Мемо2.

Выходные данные: правила в Мемо2.

procedure TForm1. btn5Click (Sender: TObject);

begin.

v: =mmo2. Lines. Count;

for i: =0 to v do p [i]: ='';

for i: =0 to v do p [i]: =mmo2. Lines [i];

mmo2. Clear;

for i: =1 to 5 do r [i]: =' '; k: =0;

for i: =0 to v do.

if Length (p [i]) =3 then.

if (p [i, 1] in ['A'. 'Z']) and (p [i, 3] in ['A'. 'Z']) and (p [i, 1] p [i, 3]) then begin.

inc (k); r [k]: =p [i, 1]; r [k+1]: =p [i, 3]; p [i]: ='';

end;

for i: =1 to k do begin.

mn [i]: = [];

for j: =i+1 to k+1 do.

mn [i]: =mn [i] + [r [j]];

end;

m: =0; l: =0;

for i: =1 to k do begin.

inc (m);

for j: =0 to v do.

if (Length (p [j]) >2) and (p [j, 1] in mn [m]) then begin.

inc (l); p [v+l]: =p [j];

p [v+l, 1]: =r [m]; end;

end;

for i: =0 to v+l do.

if Length (p [i]) >2 then mmo2. Lines. Add (p [i]);

end;

Пример использования:

• 1. Ведем правила в Мемо1
• 2. Нажмем на кнопку 1
• 3. Нажмем на кнопку 5
• 4. Разработка приложения

unit Unit1;

interface.

uses.

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,.

Dialogs, StdCtrls, ComCtrls, Grids, jpeg, ExtCtrls, XPMan, Menus, Buttons;

type.

TForm1 = class (TForm).

btn1: TButton;

mmo1: TMemo;

mmo2: TMemo;

btn2: TButton;

btn3: TButton;

btn4: TButton;

btn5: TButton;

lbl1: TLabel;

xpmnfst1: TXPManifest;

procedure btn1Click (Sender: TObject);

procedure btn2Click (Sender: TObject);

procedure btn3Click (Sender: TObject);

procedure btn4Click (Sender: TObject);

procedure btn5Click (Sender: TObject);

procedure btn1MouseMove (Sender: TObject; Shift: TShiftState; X,.

Y: Integer);

procedure btn2MouseMove (Sender: TObject; Shift: TShiftState; X,.

Y: Integer);

procedure FormMouseMove (Sender: TObject; Shift: TShiftState; X,.

Y: Integer);

procedure btn3MouseMove (Sender: TObject; Shift: TShiftState; X,.

Y: Integer);

procedure btn4MouseMove (Sender: TObject; Shift: TShiftState; X,.

Y: Integer);

procedure btn5MouseMove (Sender: TObject; Shift: TShiftState; X,.

Y: Integer);

private.

{ Private declarations }.

public.

{ Public declarations }.

end;

var.

Form1: TForm1;

i, m, n, j, v, k, l: Integer;

s, s1: string;

p: array [0.40] of string;

vn, vt, k1, k2,mm: set of Char;

mn: array [0.25] of set of Char;

c: Char;

r: array [1.5] of Char;

implementation.

{$R *. dfm}.

procedure TForm1. btn1Click (Sender: TObject);

label l;

BEGIN.

mmo2. Clear;

for i: =0 to mmo1. Lines. Count do.

if Length (mmo1. Lines [i]) >2 then begin.

mm: = []; s: =mmo1. Lines [i];

for j: =0 to Length (s) do begin.

if (s [j] in ['А'. 'Я']) or (s [j] in ['а'. 'я']) then mmo1. Lines. Delete (i);

mm: =mm+ [s [j]]; end;

if (not (s [1] in ['A'. 'Z'])) or (s [2] '-') or (' ' in mm) then mmo1. Lines. Delete (i);

end else mmo1. Lines. Delete (i);

for i: =0 to mmo1. Lines. Count do begin.

s: =mmo1. Lines [i];

n: =Pos ('/', s); Delete (s, n,1);

m: =Pos ('/', s); Delete (s, m,1);

if (n>0) and (m>0) and (n.

mmo2. Lines. Add (Copy (s, 1, n-1));

mmo2. Lines. Add (Copy (s, 1,2) +Copy (s, n, m-n));

mmo2. Lines. Add (Copy (s, 1,2) +Copy (s, m, Length (s) — m+1));

goto l;

end;

IF n>0 then begin.

mmo2. Lines. Add (Copy (s, 1, n-1));

mmo2. Lines. Add (Copy (s, 1,2) +Copy (s, n, Length (s) — n+1));

goto l;

end;

IF (n=0) and (Length (s) >2) then mmo2. Lines. Add (s);

l:

end;

for i: =0 to mmo2. Lines. Count do begin p [i]: =mmo2. Lines [i];

mn [i]: = [];

for j: =3 to Length (p [i]) do if p [i, j] in ['A'. 'Z'] then mn [i]: =mn [i] + [P [i, j]];

end;

END;

procedure TForm1. btn2Click (Sender: TObject);

var vn2: set of Char;

begin.

v: =mmo2. Lines. Count;

for i: =0 to v do p [i]: ='';

for i: =0 to v do begin p [i]: =mmo2. Lines [i];

mn [i]: = [];

for j: =3 to Length (p [i]) do.

if p [i, j] in ['A'. 'Z'] then mn [i]: =mn [i] + [P [i, j]];

end;

mmo2. Clear;

vn: = [];

for i: =0 to v-1 do if mn [i] = [] then vn: =vn+ [p [i, 1]];

vn2: = [];

j: =0;

while vnvn2 do begin.

vn: =vn2;

for i: =0 to V-1 do.

if (mn [i] - vn= []).

then vn2: =vn2+vn+ [p [i, 1]];

end;

for i: =0 to v do.

for j: =1 to Length (p [i]) do.

if Length (p [i]) >2 then if (not (p [i, j] in vn)) and (p [i, j] in ['A'. 'Z']) then p [i]: ='';

for i: =0 to v do begin mn [i]: = [];

for j: =3 to Length (p [i]) do if p [i, j] in ['A'. 'Z'] then mn [i]: =mn [i] + [p [i, j]];

if Length (p [i]) >2 then mmo2. Lines. Add (p [i]);

end;

for i: =0 to v do p [i]: ='';

for i: =0 to mmo2. Lines. Count do begin p [i]: =mmo2. Lines [i];

mn [i]: = [];

for j: =3 to Length (p [i]) do.

if p [i, j] in ['A'. 'Z'] then mn [i]: =mn [i] + [P [i, j]];

end;

end;

procedure TForm1. btn3Click (Sender: TObject);

begin.

v: =mmo2. Lines. Count;

for i: =0 to v do p [i]: ='';

for i: =0 to v do begin p [i]: =mmo2. Lines [i];

mn [i]: = [];

for j: =3 to Length (p [i]) do.

if p [i, j] in ['A'. 'Z'] then mn [i]: =mn [i] + [P [i, j]];

end;

mmo2. Clear;

vn: = [];

for i: =0 to 3 do.

if Length (p [i]) >1 then begin vn: =vn+ [p [i, 1]] +mn [0]; Break; end;

m: =0;

while m<4 do begin.

for i: =0 to v do.

if Length (p [i]) >2 then.

if p [i, 1] in vn then vn: =vn+mn [i];

Inc (m);

end;

for i: =0 to v do.

for j: =0 to Length (p [i]) do.

if Length (p [i]) >2 then if (not (p [i, j] in vn)) and (p [i, j] in ['A'. 'Z']) then p [i]: ='';

for i: =0 to v do.

if Length (p [i]) >2 then mmo2. Lines. Add (p [i]);

for i: =0 to v do p [i]: ='';

for i: =0 to mmo2. Lines. Count do begin p [i]: =mmo2. Lines [i];

mn [i]: = [];

for j: =3 to Length (p [i]) do.

if p [i, j] in ['A'. 'Z'] then mn [i]: =mn [i] + [P [i, j]];

end;

end;

procedure TForm1. btn4Click (Sender: TObject);

begin.

v: =mmo2. Lines. Count;

for i: =0 to v do p [i]: ='';

for i: =0 to v do begin p [i]: =mmo2. Lines [i];

mn [i]: = [];

for j: =3 to Length (p [i]) do.

if p [i, j] in ['A'. 'Z'] then mn [i]: =mn [i] + [P [i, j]];

end;

mmo2. Clear;

j: =0;

for i: =0 to v do.

if Length (p [i]) >2 then.

if p [i, 3] ='e' then begin.

Inc (j); r [j]: =p [i, 1]; p [i]: ='';

end;

n: =j; k: =0;

for i: =1 to n do.

for j: =0 to v do begin.

if Length (p [j]) >1 then.

if r [i] in mn [j] then begin.

s: =p [j];

Delete (s, 1,2);

s1: =s;

m: =Pos (r [i], s);

delete (s, m,1);

l: =Pos (r [i], s);

if (m>0) and (l>0) then begin.

inc (k);

p [k+v]: =Copy (p [j], 1,2) +s;

Inc (k); l: =Pos (r [i], s); Delete (s1,l+1,1);

p [k+v]: =Copy (p [j], 1,2) +s1;

Inc (k); l: =Pos (r [i], s1); Delete (s1,l, 1);

p [k+v]: =Copy (p [j], 1,2) +s1;

end;

if (m>0) and (l=0) then begin.

inc (k);

p [k+v]: =Copy (p [j], 1,2) +s;

end;

end; end;

for i: =0 to v+ (k-1) do.

for j: =i+1 to v+k do begin.

if p [i] =p [j] then p [j]: ='';

if (Length (p [i]) =3) and (p [i, 1] =p [i, 3]) then p [i]: ='';

end;

for i: =0 to v+k do.

if Length (p [i]) >2 then mmo2. Lines. Add (p [i]);

for i: =0 to v do p [i]: ='';

for i: =0 to mmo2. Lines. Count do begin p [i]: =mmo2. Lines [i];

mn [i]: = [];

for j: =3 to Length (p [i]) do.

if p [i, j] in ['A'. 'Z'] then mn [i]: =mn [i] + [P [i, j]];

end;

end;

procedure TForm1. btn5Click (Sender: TObject);

begin.

v: =mmo2. Lines. Count;

for i: =0 to v do p [i]: ='';

for i: =0 to v do p [i]: =mmo2. Lines [i];

mmo2. Clear;

for i: =1 to 5 do r [i]: =' '; k: =0;

for i: =0 to v do.

if Length (p [i]) =3 then.

if (p [i, 1] in ['A'. 'Z']) and (p [i, 3] in ['A'. 'Z']) and (p [i, 1] p [i, 3]) then begin.

inc (k); r [k]: =p [i, 1]; r [k+1]: =p [i, 3]; p [i]: ='';

end;

for i: =1 to k do begin.

mn [i]: = [];

for j: =i+1 to k+1 do.

mn [i]: =mn [i] + [r [j]];

end;

m: =0; l: =0;

for i: =1 to k do begin.

inc (m);

for j: =0 to v do.

if (Length (p [j]) >2) and (p [j, 1] in mn [m]) then begin.

inc (l); p [v+l]: =p [j];

p [v+l, 1]: =r [m]; end;

end;

for i: =0 to v+l do.

if Length (p [i]) >2 then mmo2. Lines. Add (p [i]);

end;

procedure TForm1. btn1MouseMove (Sender: TObject; Shift: TShiftState; X,.

Y: Integer);

begin.

lbl1. Caption: ='Анализ грамматики';

end;

procedure TForm1. btn2MouseMove (Sender: TObject; Shift: TShiftState; X,.

Y: Integer);

begin.

lbl1. Caption: ='Удаление бесплодных символов';

end;

procedure TForm1. FormMouseMove (Sender: TObject; Shift: TShiftState; X,.

Y: Integer);

begin.

lbl1. Caption: ='Приведение грамматики';

end;

procedure TForm1. btn3MouseMove (Sender: TObject; Shift: TShiftState; X,.

Y: Integer);

begin.

lbl1. Caption: ='Удаление недостижимых символов';

end;

procedure TForm1. btn4MouseMove (Sender: TObject; Shift: TShiftState; X,.

Y: Integer);

begin.

lbl1. Caption: ='Преобразование неукорачивающих правил';

end;

procedure TForm1. btn5MouseMove (Sender: TObject; Shift: TShiftState; X,.

Y: Integer);

begin.

lbl1. Caption: ='Исключение цепных правил';

end;

end.

Пример работы программы:

Шаг 1: вводим правила в Мемо1.

Шаг 2: нажимаем на кнопку 1.

Шаг 3: нажимаем на кнопку 2.

Шаг 4: нажимаем на кнопку 3.

Шаг 5: нажимаем на кнопку 4.

Шаг 6: нажимаем на кнопку 5.