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

             m=3;             {Количество контрольных бит}

  type vec =array[1..n] of byte;

       matr=array[1..n,1..m] of byte;

                                  {Порождающая матрица}

  const Gkn : array[1..k,1..n] of byte=((1,0,0,0, 1,1,1),

                                                              (0,1,0,0, 0,1,1),

                                                              (0,0,1,0, 1,1,0),

                                                               (0,0,0,1, 1,0,1));

           {Проверочная матрица}

       Hmn : array[1..m,1..n] of byte=((1,0,1,1, 1,0,0),

                                                           (1,1,1,0, 0,1,0),

                                                           (1,1,0,1, 0,0,1));

  var

      HmnT                                                       :matr;

      inp_inf_word,inp_code_word                  :vec;

      out_inf_word,out_code, out_code_word :vec;

         {Входные и выходные информационные и кодовые слова}

      i,j,n_err,dec_inp,dec_out,dec                  :byte;

      code_err,number                                     :byte;

      ch                                                            :char;

  procedure Dec_Bin(dec:byte; var z:vec);

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

    Const c:array[1..4] of byte =(8,4,2,1);

    begin

      For i:=1 to 4 do z[i]:=0;

      For i:=1 to 4 do if dec>=c[i] then

        begin

          z[i]:=1;  dec:=dec-c[i];

        end;

    end;

  procedure Bin_Dec(z:vec; var dec:byte);

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

    Const c:array[1..4] of byte =(8,4,2,1);

    begin

      dec:=0; for i:=1 to k do if z[i]=1 then dec:=dec+c[i];

    end;

procedure Coder(inp_word:vec; var code_word:vec);

   {Процедура кодирования}

    var s         :byte;

    begin

      For j:=1 to n do

        begin

          s:=0; for i:=1 to k do if inp_word[i]=1 then s:=s xor Gkn[i,j];

          code_word[j]:=s;

       end;

     end;

    procedure De_Coder(err_code:vec; var out_code:vec);

   {Процедура декодирования}

    var s         :byte;

    begin

      For j:=1 to m do

        begin

          s:=0; for i:=1 to n do if err_code[i]=1 then s:=s xor HmnT[i,j];

          out_code[j]:=s;

       end;

    end;

  procedure Trans( var zt:matr);

   {Транспонирование проверочной матрицы}

    begin

      for i:=1 to m do

        for j:=1 to n do zt[j,i]:=Hmn[i,j];

      end;

  procedure ErrorBit(code:vec; var nb:byte);

    {Определение ошибочного бита}

    Var R            :byte;

    begin

      R:=0;

      for i:=1 to n do

        for j:=1 to m do  if code[j]=HmnT[j,1] then R:=R+1;

        if R=3 then nb:=i;

     end;

 begin

   clrscr;  TextColor(White);

   randomize;

 repeat

     clrscr;

     TextColor(Yellow);

     writeln( ' ':18,' ЛИНЕЙНЫЙ ГРУППОВОЙ КОД (7,4)'); writeln;

     TextColor(White);

     dec_inp:=random(10);

      { write('  Введите цифру',' ':23,'=> ');  read(figi);}

     TextColor(9);

     writeln('РАБОТАЕТ КОДЕР');

     TextColor(White);

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

     Dec_Bin(dec_inp,inp_inf_word);

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

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

     TextColor(Green);

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

     TextColor(White);

     writeln;

     {Вызов процедуры кодирования}

     Coder(inp_inf_word,inp_code_word);

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

     TextColor(LightRed);