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));