Twardodecyzyjny dekoder Viterbiego

Po wielu bezsennych nocach wreszcie udało mi się zaimplementować (w Delphi) twardodecyzyjny dekoder Viterbiego. Niestety przestał działać jak należy po tym jak przerobiłem go do dekodowania kodu splotowego o sprawności 2/3 (wcześniej był o sprawności 1/2). I nie mam żadnego pomysłu jak go przerobić żeby działał. Kod jest całkowicie mojego patentu i raczej ciężko zrozumieć jak działa. Jeżeli jednak ktoś wykryje jakiś błąd albo ma jakis inny działający kod takiego dekodera to będę bardzo wdzięczny!

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Math, Buttons, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    BDekoduj: TButton;
    Image1: TImage;
    RichEdit1: TRichEdit;
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Button2: TButton;
    procedure BDekodujClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
  private
    { Private declarations }
    procedure Dekoduj(var Buffer_In:Array of Byte; var Dl_We:DWord; var Buffer_Out:Array of Byte; var Dl_Wy:DWord);
    function Hamming_Distance(In1:Byte; In2:Byte):Byte;
  public
    { Public declarations }
  end;

type
  Sc = Record
    Data:Array[0..400] of Byte;
    StaryOstatniStan:Byte;
    NowyOstatniStan:Byte;
    StaraMetryka:Word;
    NowaMetryka:Word;
    Istnieje:Byte;
    JuzPrzedluzona:Byte;
  end;

  
const
  Ile_Bitow = 3;
  Ile_Stanow = 8;    //2^Ile_Bitow

  Po_Ile_Otwierac = 32768;

var
  Form1: TForm1;
  Buffer1:Array[0..20000000] of Byte;
  Buffer2:Array[0..40000000] of Byte;
  Buffer3:Array[0..40000000] of Byte;
  Dl1:DWord;
  Dl2:DWord;
  Odebrane:Array[0..40000000] of Byte;
  Sciezka:Array[0..Ile_Stanow*2-1] of Sc;
  SkadMozeIsc:Array[0..Ile_Stanow-1, 0..((Ile_Stanow Div 2)-1)] of Byte;
  Etykieta:Array[0..Ile_Stanow-1, 0..((Ile_Stanow Div 2)-1)] of Byte;
  DokadIdzie:Array[0..Ile_Stanow-1, 0..Ile_Stanow-1] of Byte;
  CoTo:Array[0..Ile_Stanow-1, 0..Ile_Stanow-1] of Byte;

implementation

{$R *.dfm}
//-----------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
var
  We1, We2:Byte;
  R1, R2, R3:Byte;
  Wy1, Wy2, Wy3:Byte;
  We:DWord;
  Stan:Byte;
  Stan2:Byte;
  Wy:Byte;
  KtoreDojscie:Array[0..(Ile_Stanow-1)] of Byte;
begin
  For We1:=0 to Ile_Stanow-1 do
    KtoreDojscie[We1]:=0;

  For Stan:=0 to Ile_Stanow-1 do
    begin
      For We:=0 to (Ile_Stanow Div 2)-1 do
        begin
          We2:=We Shr 1;
          We1:=We And 1;


          R1:=Stan And 1;
          R2:=(Stan Shr 1) And 1;
          R3:=Stan Shr 2;

          Wy3:=(We1+We2) And 1;
          Wy3:=(Wy3+R2) And 1;
          Wy3:=(Wy3+R3) And 1;

          Wy2:=(We2+R1) And 1;

          Wy1:=(We1+R1) And 1;
          Wy1:=(Wy1+R3) And 1;

          Wy:=Wy1 + Wy2*2 + Wy3*4;

          R3:=R2;
          R2:=We2;
          R1:=We1;

          Stan2:=R1 + R2*2 + R3*4;

        {  We1:=We;

          R1:=Stan And 1;
          R2:=Stan Shr 1;

          Wy2:=(We1 + R2) And 1;
          Wy1:=(Wy2 + R1) And 1;

          Wy:=Wy1 + Wy2*2;

          R2:=R1;
          R1:=We1;

          Stan2:=R1 + R2*2;    }


          SkadMozeIsc[Stan2, KtoreDojscie[Stan2]]:=Stan;
          Etykieta[Stan2, KtoreDojscie[Stan2]]:=Wy;

          Inc(KtoreDojscie[Stan2]);

          DokadIdzie[Stan, Wy]:=Stan2;
          CoTo[Stan, Wy]:=We;
        end;
    end;
end;
//-----------------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
var
  i:Word;
  We1:Byte;
  We2:Byte;
  R1:Byte;
  R2:Byte;
  R3:Byte;
begin
  R1:=0;
  R2:=0;
  R3:=0;

  Edit1.Text:=Edit1.Text + '0000';

  For i:=0 to 31 do
    begin
      We1:=StrToInt(Edit1.Text[i*2+1]);
      We2:=StrToInt(Edit1.Text[i*2+2]);

      Odebrane[i*Ile_Bitow+2]:=(We1+We2) And 1;
      Odebrane[i*Ile_Bitow+2]:=(Odebrane[i*Ile_Bitow+2]+R2) And 1;
      Odebrane[i*Ile_Bitow+2]:=(Odebrane[i*Ile_Bitow+2]+R3) And 1;

      Odebrane[i*Ile_Bitow+1]:=(We2+R1) And 1;

      Odebrane[i*Ile_Bitow+0]:=(We1+R1) And 1;
      Odebrane[i*Ile_Bitow+0]:=(Odebrane[i*Ile_Bitow+0]+R3) And 1;

      R3:=R2;
      R2:=We2;
      R1:=We1;

      Edit2.Text:=Edit2.Text + IntToStr(Odebrane[i*Ile_Bitow]) + IntToStr(Odebrane[i*Ile_Bitow+1]) + IntToStr(Odebrane[i*Ile_Bitow+2]);
    end;


{  For i:=0 to 31 do
    begin
      We1:=StrToInt(Edit1.Text[i+1]);

      Odebrane[i*Ile_Bitow+1]:=(We1 + R2) And 1;
      Odebrane[i*Ile_Bitow]:=(Odebrane[i*Ile_Bitow+1] + R1) And 1;

      R2:=R1;
      R1:=We1;

      Edit2.Text:=Edit2.Text + IntToStr(Odebrane[i*Ile_Bitow]) + IntToStr(Odebrane[i*Ile_Bitow+1]);
    end;   }
end;
//-----------------------------------------------------------
procedure TForm1.Dekoduj(var Buffer_In:Array of Byte; Var Dl_We:DWord; var Buffer_Out:Array of Byte; var Dl_Wy:DWord);
var
  i:DWord;
  j:DWord;
  k:Byte;
  l:ShortInt;
  m:Array[0..((Ile_Stanow Div 2)-1)] of ShortInt;
  n:Integer;
  w:Byte;
  Dana:Byte;
  Odl:Array[0..((Ile_Stanow Div 2)-1)] of Byte;
  Odleglosc:Array[0..((Ile_Stanow Div 2)-1)] of Word;
  Min:Word;
label
  Juz;
begin
//Twardodecyzyjny dekoder Viterbiego

//  For i:=0 to Dl_We-1 do
//    For j:=0 to 7 do
//      Odebrane[i*8 + j]:=(Buffer_In[i] Shr j) And 1;


  Dl_We:=12;


  For i:=0 to Ile_Stanow*2-1 do
    begin
      Sciezka[i].StaraMetryka:=0;
      Sciezka[i].Istnieje:=0;
      Sciezka[i].StaryOstatniStan:=0;
      Sciezka[i].JuzPrzedluzona:=0;
    end;

  Sciezka[0].Istnieje:=1;

  For i:=0 to ((Dl_We*8) Div Ile_Bitow)-1 do
    begin
      Dana:=Odebrane[i*3] + Odebrane[i*3+1]*2 + Odebrane[i*3+2]*4;
      //Dana:=Odebrane[i*2] + Odebrane[i*2+1]*2;

      For j:=0 to Ile_Stanow-1 do  //Dla każdego stanu końcowego
        begin
          For k:=0 to ((Ile_Stanow Div 2)-1) do  //Dla każdej gałęzi
            begin               //dochodzącej do tego stanu
              Odl[k]:=Hamming_Distance(Dana, Etykieta[j, k]);
              m[k]:=-1;
            end;


          For k:=0 to Ile_Stanow*2-1 do  //Dla każdej scieżki
            If Sciezka[k].Istnieje = 1 Then      //Jeżeli dana scieżka istnieje
              begin
                For l:=0 to Ile_Bitow-1 do
                  If SkadMozeIsc[j, l] = Sciezka[k].StaryOstatniStan Then  //I jeżeli
                    //jej ostatni stan jest taki jakiego szukany
                    //(czyli jeżeli galąż przedluża tę scieżkę)
                    begin
                      Odleglosc[l]:=Odl[l] + Sciezka[k].StaraMetryka;
                      m[l]:=k;
                    end;
              end;


          Min:=65530;
          l:=-1;

          For k:=0 to Ile_Bitow-1 do
            If m[k] <> -1 Then
              If Odleglosc[k] < Min Then
                begin
                  Min:=Odleglosc[k];
                  l:=m[k];
                  w:=k;
                end;


          If l <> -1 Then
            begin
              If Sciezka[l].JuzPrzedluzona = 0 Then
                begin
                  Sciezka[l].Data[i]:=Etykieta[j, w];
                  Sciezka[l].NowyOstatniStan:=j;
                  Sciezka[l].NowaMetryka:=Min;
                  Sciezka[l].JuzPrzedluzona:=1;
                end
              Else
                begin
                  For k:=0 to Ile_Stanow*2-1 do
                    If (Sciezka[k].Istnieje = 0) And (Sciezka[k].JuzPrzedluzona = 0) Then
                      begin
                        For n:=0 to i do
                          Sciezka[k].Data[n]:=Sciezka[l].Data[n];


                        Sciezka[k].Data[i]:=Etykieta[j, w];
                        Sciezka[k].NowyOstatniStan:=j;
                        Sciezka[k].NowaMetryka:=Min;
                        Sciezka[k].JuzPrzedluzona:=1;

                        GoTo Juz;
                      end;

                  Juz:
                end;
            end;
        end;

      For k:=0 to Ile_Stanow*2-1 do
        begin
          Sciezka[k].Istnieje:=Sciezka[k].JuzPrzedluzona;

          Sciezka[k].StaraMetryka:=Sciezka[k].NowaMetryka;
          Sciezka[k].StaryOstatniStan:=Sciezka[k].NowyOstatniStan;

          Sciezka[k].JuzPrzedluzona:=0;
        end;


      RichEdit1.Clear;
      Image1.Canvas.Rectangle(0, 0, 700, 200);

      For k:=0 to Ile_Stanow*2-1 do
        If Sciezka[k].Istnieje = 1 Then
          begin
            Image1.Canvas.MoveTo(0, 10);

            Dana:=0;

            For l:=0 to i do
              begin
                Dana:=DokadIdzie[Dana, Sciezka[k].Data[l]];
                RichEdit1.Text:=RichEdit1.Text + IntToStr(Dana) + '  ';
                w:=((Dana Shl 2) And 4) + (Dana And 2) + (Dana Shr 2);
                //w:=((Dana Shl 1) And 2) + (Dana Shr 1);

                Image1.Canvas.LineTo(l*10+10, w*10+10);
              end;

            RichEdit1.Lines.Add('');
          end;

      //Showmessage('dddd');
    end;


  //Min:=65530;
  l:=0;
  For k:=0 to Ile_Stanow*2-1 do
    If Sciezka[k].Istnieje = 1 Then
      //If Sciezka[k].StaraMetryka < Min Then
      If Sciezka[k].StaryOstatniStan = 0 Then
        begin
          //Min:=Sciezka[k].StaraMetryka;
          l:=k;
        end;


  Edit3.Text:='';
  Dana:=0;
  For k:=0 to ((Dl_We*8) Div Ile_Bitow)-1 do
    begin
      w:=CoTo[Dana, Sciezka[l].Data[k]];
      Edit3.Text:=Edit3.Text + IntToStr(w And 1) + IntToStr(w Shr 1);
      //Edit3.Text:=Edit3.Text + IntToStr(w);

      Dana:=DokadIdzie[Dana, Sciezka[l].Data[k]];
    end;
end;
//-----------------------------------------------------------
function TForm1.Hamming_Distance(In1:Byte; In2:Byte):Byte;
var
  i:Byte;
  j:Byte;
  k:Byte;
begin
  j:=In1 Xor In2;

  k:=0;

  For i:=0 to 2 do
    If ((j Shr i) And 1) > 0 Then
      Inc(k);

  Result:=k;
end;
//-----------------------------------------------------------
procedure TForm1.BDekodujClick(Sender: TObject);
begin
  Dl1:=24;
  Dekoduj(Buffer2, Dl1, Buffer1, Dl2);
end;
//-----------------------------------------------------------
procedure TForm1.Edit2Change(Sender: TObject);
var
  i:Byte;
begin
  For i:=1 to Length(Edit2.Text) do
    Odebrane[i-1]:=StrToInt(Edit2.Text[i]);
end;
//-----------------------------------------------------------
end.

  Koder splotowy o sprawnosci 1/2:

  R1:=0;
  R2:=0;

  For i:=0 to 31 do
    begin
      j:=StrToInt(Edit1.Text[i+1]);

      Odebrane[i*2+1]:=(j + R2) And 1;
      Odebrane[i*2]:=(Odebrane[i*2+1] + R1) And 1;

      R2:=R1;
      R1:=j;
    end;



  Ile_Bitow = 2;
  Ile_Stanow = 4;    //2^Ile_Bitow

  SkadMozeIsc:Array[0..Ile_Stanow-1, 0..((Ile_Stanow Div 2)-1)] of Byte =
  ((0,    //00 --> 00  00/0
    1),   //01 --> 00  11/0
   (2,    //10 --> 01  10/0
    3),   //11 --> 01  01/0
   (0,    //00 --> 10  11/1
    1),   //01 --> 10  00/1
   (2,    //10 --> 11  01/1
    3));  //11 --> 11  10/1

  Etykieta:Array[0..Ile_Stanow-1, 0..((Ile_Stanow Div 2)-1)] of Byte =
  ((0,    //00 --> 00  00/0
    3),   //01 --> 00  11/0
   (2,    //10 --> 01  10/0
    1),   //11 --> 01  01/0
   (3,    //00 --> 10  11/1
    0),   //01 --> 10  00/1
   (1,    //10 --> 11  01/1
    2));  //11 --> 11  10/1

  DokadIdzie:Array[0..Ile_Stanow-1, 0..Ile_Stanow-1] of Byte =
  ((0,    //00 --> 00  00/0
    0,
    0,
    2),   //00 --> 10  11/1
   (2,    //01 --> 10  00/1
    0,
    0,
    0),   //01 --> 00  11/0
   (0,
    3,    //10 --> 11  01/1
    1,    //10 --> 01  10/0
    0),
   (0,
    1,    //11 --> 01  01/0
    3,    //11 --> 11  10/1
    0));

  CoTo:Array[0..Ile_Stanow-1, 0..Ile_Stanow-1] of Byte =
  ((0,    //00 --> 00  00/0
    0,
    0,
    1),   //00 --> 10  11/1
   (1,    //01 --> 10  00/1
    0,
    0,
    0),   //01 --> 00  11/0
   (0,
    1,    //10 --> 11  01/1
    0,    //10 --> 01  10/0
    0),
   (0,
    0,    //11 --> 01  01/0
    1,    //11 --> 11  10/1
    0));