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<m) then begin

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 vn<>vn2 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