Реализация алгоритма по устранению цепных продукций

begin

for k2:=0 to n do

if s1[k2+1,0]<>'' then

begin

for l:='A' to 'Z'do

  begin

     i:=i2; j:=0;i1:=n;

    repeat

      i:=i-1;

      repeat

        j:=j+1;

        if l=s1[i+1,j]

        then

        begin

          repeat

            i1:=i1-1;

            if s1[i1,0]=l

            then

            begin

{--------------------------сдвиг------------}

             while s1[i+1,j]<>'' do

              begin

                s1[i+1,j]:=s1[i+1,j+1];

                j:=j+1;

              end;

              j1:=1;

{----запоминаем  старые и вставляем новые---}

              repeat

                s3[j1]:=s1[i+1,j];

                s1[i+1,j-1]:=s1[i1,j1];

                j:=j+1;     j1:=j1+1;

              until s1[i1,j1]='';

              j1:=1; 

{----вставляем  новые-запоминые символы--}

              repeat

                s1[i+1,j]:=s3[j1];

                j:=j+1;     j1:=j1+1;

              until s3[j1]='';

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

            end;

        until i1=0;

     end;

      until s1[i,j]='';

    until i=0;

  end; udprod;

  end1; 

end 

else

    break;

end;

{==================================================}

mmOutput.Lines.Add('_'); 

end;

{============================================================}

Procedure con;

var i,j:byte; s:string;

begin

     mmOutput.Lines.Add('__');

     s:='';    i:=0;

     while (s1[i,0]<>'') do

     begin    j:=0;

     while (s1[i,j]<>'') do

     begin

       j:=j+1;

       if s1[i,j+1]<>''

       then

         begin

           s:=s+s1[i,j]+'|';

         end 

       else

         s:=s+s1[i,j];

     end;

     s:=s1[i,0]+'"->'+s;

     i:=i+1;

     mmOutput.Lines.Add(s);

     S:='';

     end;

end;

{============================================================}

begin

  {s1[0,0]:='S';s1[0,1]:='ABC';s1[0,2]:='B';s1[0,3]:='B';s1[0,4]:='S';s1[0,5]:='F';s1[0,6]:='';

  s1[1,0]:='B';s1[1,1]:='B';s1[1,2]:='0C';s1[1,3]:='S';s1[1,4]:='a';s1[1,5]:='';

  s1[2,0]:='A';s1[2,1]:='x';s1[2,2]:='F';s1[2,3]:='B';s1[2,4]:='1';s1[2,5]:='1x';s1[2,6]:='';

  s1[3,0]:='F';s1[3,1]:='A';s1[3,2]:='01';s1[3,3]:='B0';s1[3,4]:='11';s1[3,5]:='1x0';s1[3,6]:='';

                         }

  {s1[0,0]:='W';s1[0,1]:='S';s1[0,2]:='e';s1[0,3]:='';s1[0,4]:='';s1[0,5]:='';s1[0,6]:='';

  s1[1,0]:='S';s1[1,1]:='0A';s1[1,2]:='0';s1[1,3]:='1B';s1[1,4]:='1';s1[1,5]:='';

  s1[2,0]:='A';s1[2,1]:='AB';s1[2,2]:='A';s1[2,3]:='B';s1[2,4]:='0';s1[2,5]:='';s1[2,6]:=''

  s1[3,0]:='B';s1[3,1]:='0';s1[3,2]:='';s1[3,3]:='';s1[3,4]:='';s1[3,5]:='';s1[3,6]:='';

{s1[4,0]:='AB';s1[4,1]:='A';s1[4,2]:='B';s1[4,3]:='';s1[4,4]:='';s1[4,5]:='';s1[4,6]:='';} 

  {-----Копирование  матрицы--------------}

  for i:=0 to n do

  for j:=0 to n do

    s2[i,j]:=s1[i,j];

{Очистка Memo}

mmOutput.Lines.clear;

{========Вывод исходной  матрицы=======================}

       s:=' ';    i:=0;

     while (s2[i,0]<>'') do

     begin    j:=0;

     while (s2[i,j]<>'') do

     begin

       j:=j+1;

       if s2[i,j+1]<>''

       then

         begin

           s:=s+s2[i,j]+'|';

         end 

       else

         s:=s+s2[i,j];

     end;

     s:=s2[i,0]+'->'+s;

     i:=i+1;

     mmOutput.Lines.Add(s);

     S:='';

     end;

{======================================================} 

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

udprod;

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

end1;

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

for i:=0 to n do

if s1[i+1,0]<>'' then

pr

else

break;

{=============Удаление  одинаковых значений========================}

udprod;

{=======================================}

end1;

{----Удаление  оставшихся продукций---------}

for i:=0 to n do

  for j:=1 to n do

  for l:='A' to 'Z'do

  if s1[i,j]=l  then

   s1[i,j]:='';

con;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

mmOutput.Lines.Add('');

mmOutput.Lines.Add('Введите  последовательно построчно без  пробелов');

mmOutput.Lines.Add('   соответствующие строки');

mmOutput.Lines.Add('  Пример1        ');

mmOutput.Lines.Add('   S->ABC|0A|e|A ');

mmOutput.Lines .Add('   A->BBC|0C|1|B ');

mmOutput.Lines.Add('   B->A00|B0A|11|B ');

mmOutput.Lines.Add('                 ');

end; 

procedure TForm1.bbRun2Click(Sender: TObject);

  var i,j:byte;

begin

{Очистка Memo}

mmOutput.Lines.clear;

mmOutput.Lines.Add(' ');

mmOutput.Lines.Add('');

mmOutput.Lines.Add('КонтрольныЙ  примерэ');

mmOutput.Lines.Add('  Пример1          ');

mmOutput.Lines.Add('   S->ABC|0A|e|A   ');

mmOutput.Lines.Add('   A->BBC|0C|1|B   ');

mmOutput.Lines.Add('   B->A00|B0A|11|B ');

mmOutput.Lines.Add('                   ');

bbrun.Tag:=0;

for i:=0 to n do

  for j:=0 to n do

    s1[i,j]:='';

  {-----Копирование  матрицы--------------}

  for i:=0 to n do

  for j:=0 to n do

    s2[i,j]:=s1[i,j]; 

end;

end.