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