Кодирование с использованием линейного группового кода, страница 5

        vec1=array[1..m] of byte;

 var

      a,b                                      :vec;

      i,j,no,s,p1,p2,p3,figi,figo   :byte;

      ch                                      :char;

      code_err,number               :integer;

      l1,l2                                   :Boolean;

 procedure CheckSum(z:vec; d:byte; Var S:byte);

  begin

    s:=0;  for j:=1 to n do if H[d,j]=1 then s:=s xor z[j]

  end;

 procedure Coder;

  Var r        :integer;

      ni       :byte;

  begin

    TextColor(White);

    writeln;

    figi:=random(10);

    writeln('  Передаваемая цифра',' ':18,'=> ',figi);

  {Преобразование десятичного числа в двоичный код}

  For i:=1 to k do a[i]:=0;

  i:=k;

  Repeat

     r:= figi mod 2; a[i]:=r; ni:=i; i:=i-1; figi:= figi div 2;

   Until figi<2;

   a[ni-1]:=figi;

    write('  Передаваемое информационное слово',' ':3,'=> ','а[i]=');

    TextColor(Green);  for i:=1 to k do write (a[i]);    TextColor(White);

    writeln;

    for i:=1 to n do b[i]:=0;

    b[3]:=a[1];

    for i:=5 to n do b[i]:=a[i-3];

       { Определяем значения контрольных сумм}

    CheckSum(b,3,p1); b[1]:=p1;    CheckSum(b,2,p2); b[2]:=p2;    CheckSum(b,1,p3);    b[4]:=p3;

    write('  Передаваемая кодовая комбинация',' ':5,'=> ','b[i]=');

    TextColor(LightRed);    for i:=1 to n do write(b[i]);   TextColor(White);

    writeln;

  end;

 procedure Canal;

  begin

    { Вводим ошибку в передаваемую кодовую комбинацию}

    no:=random(n)+1;

    {Инвертирование бита}

    if (no>0) and (no<=n) then  b[no]:=b[no] xor 1;

    write('  Принятая кодовая комбинация',' ':9,'=> ','b[i]=');

    TextColor(LightRed);

    for i:=1 to n do

      begin

        if i=no then

          begin

            TextColor(White);   write(b[i]);   TextColor(LightRed);

          end

          else  write(b[i]);

      end;

     writeln;

  end;

 procedure Decoder;

  Var z      :vec1;

  begin

    { Определяем значения контрольных сумм}

    CheckSum(b,3,p1);z[3]:=p1;   CheckSum(b,2,p2);z[2]:=p2;   CheckSum(b,1,p3);z[1]:=p3;

    { Определяем позицию искаженного бита}

    for j:=1 to n do

     begin

      s:=0;   for i:=3 downto 1 do s:=s+H[i,j] xor z[i];   if s=0 then number:=j

     end;

    {Инвертирование бита}

    b[number]:=b[number] xor 1;

    TextColor(White);    write('  Правильная кодовая комбинация',' ':7,'=> ','b[i]=');    TextColor(LightRed);

    for i:=1 to n do

     begin

      if i=no then

       begin

        TextColor(White);     write(b[i]);  TextColor(LightRed);

       end

          else  write(b[i]);

      end;

    writeln;

    a[1]:=b[3];

    for i:=2 to k do a[i]:=b[i+3];

    TextColor(White);    write('  Правильное сообщение',' ':16,'=> ','а[i]=');    TextColor(Green);

    for i:=1 to k do write (a[i]);

    TextColor(White);

    writeln;

    figo:=0;

    for i:=1 to k do figo:=figo+a[i]*trunc(exp((4-i)*ln(2)));

    writeln('  Принятая цифра',' ':22,'=> ',figo);

    writeln; writeln;

  end;

  begin

    clrscr;

    Randomize;

    repeat

      clrscr;   TextBackGround(7);  clrscr;

      TextColor(Yellow);

      writeln( ' ':22,' КОД ХЕММИНГА (7,4)'); writeln; writeln;

      TextColor(RED);      writeln;

      writeln( ' ':22,' CODER');

      TextColor(Yellow);

      Coder;   TextColor(RED);   writeln( ' ':22,' CANAL'); writeln;    TextColor(Yellow);

      writeln;

      Canal;      TextColor(RED);   writeln( ' ':22,'DECODER'); writeln;   TextColor(Yellow);

      Decoder;

      ch:=readkey;

    Until ch=#27 {Выход при нажатии кл. Esc}

 End.

Результат работы программы