{
  Joachim Deckers
  Anlage zur 2. Staatsexamensarbeit / 28.5.96

  Diese Unit wird für Aufgabe 7 benötigt ("7.3.5.3 Exkurs: Hamming-Codes")
  Sie stellt eine Testprozedur für die Kodierung/Dekodierung zur Verfügung.

}

unit bitstr;

INTERFACE

  {$F+} { FAR-Aufrufe erzwingen }

  type kodierungsfunktion = function(s: string): string;
       Pkodierungsfunktion= ^kodierungsfunktion;

  function string2bitstring(s: string): string;
    { Wandelt einen String in einen Bitstring, d. h. einen
      String aus den Zeichen '0' und '1', um, der die Bitfolge
      von s darstellt. } 
  function bitstring2string(s: string): string;
    { Wandelt einen Bitstring in den String um,
      dessen Bitfolge er repräsentiert. }
      
  procedure teste(kodiere, dekodiere: kodierungsfunktion; fehlersim: boolean);

  const fehlerrate = 2e-2;
  var   fehler     : integer;


IMPLEMENTATION

  procedure verfaelsche(var s: string);
  var i: integer;
  begin
    randomize;
    fehler:=0;
    for i:=1 to length(s) do
      if random<fehlerrate then begin
        s[i] := char(ord('0')+abs(ord(s[i])-ord('0')-1));
        inc(fehler)
      end
  end;

  function string2bitstring(s: string): string;
  type string8 = string[8];
  var i: integer;
      a: string;

      function char2bitstring(c: char): string8;
      var i : integer;
          bs: string8;
      begin
        bs:='';
        for i:=1 to 8 do begin
          bs := char (ord('0') + (byte(c) and 1)) + bs;
          c  := char(byte(c) shr 1)
        end;
        char2bitstring := bs
      end;

  begin
    a:='';
    if length(s)>64 then
      Writeln('Die Länge des Strings für string2bitstring darf 64 nicht überschreiten!')
    else
      for i:=1 to Length(s) do
        a:=a+char2bitstring(s[i]);
    string2bitstring:=a
  end;

  function bitstring2string(s: string): string;
  type string1 = string[1];
  var i: integer;
      a: string;

    function bitstring2char(bs: string): char;
    var i: integer;
        b: byte;
    begin
      b:=0;
      for i:=1 to 8 do
        b:=2*b + ord(bs[i])-ord('0');
      bitstring2char := char(b)
    end;

  begin
    a:='';
    if (length(s) mod 8)<>0 then
      Writeln('Die Länge des Strings für bitstring2string muß ein Vielfaches von 8 sein!')
    else
      for i:=1 to length(s) div 8 do
        a:=a+bitstring2char(Copy(s,(i-1)*8+1,8));
    bitstring2string := a
  end;

  procedure teste;
  var     zeile,
          bs_ascii,
          bs_code,
          bs_ocode,
          bs_decode,
          bs_decodeascii : string;
          i              : integer;

  begin
    writeln;
    writeln('Testroutine für die Funktionen kodiere und dekodiere');
    writeln;
    write('Bitte geben Sie einen Text ein: ');
    readln(zeile);
    if Length(zeile)>12 then begin
      Writeln('Zeile zu lang für diesen Test, schneide ab zu: ');
      zeile[0]:=#12;
      Writeln(zeile)
    end;
    writeln('Die Bitfolge dieses Textes im ASCII-Code ist');
    bs_ascii:=string2bitstring(zeile);
    writeln(bs_ascii);
    writeln('Die Bitfolge dieses Textes im Beispielcode ist');
    bs_code:=kodiere(bs_ascii);
    writeln(bs_code);
    if fehlersim then begin
      bs_ocode:=bs_code;
      verfaelsche(bs_code);
      Writeln('Code nach Simulierung einer gestörten Übertragung (',fehler,' Fehler):');
      Writeln(bs_code)
    end;
    writeln('Dekodiert ergibt sich');
    bs_decode:=dekodiere(bs_code);
    writeln(bs_decode);
    writeln('Als Text bedeutet dieses');
    bs_decodeascii:=bitstring2string(bs_decode);
    writeln(bs_decodeascii);
    writeln;
    if fehlersim and (fehler>0) then 
      if bs_decodeascii=zeile then
        Writeln('Alle ',fehler,' Fehler wurden korrigiert.')
      else begin
        Writeln('Es wurden nicht alle ',fehler,' Fehler korrigiert!!!');
        for i:=1 to length(zeile) do
          if zeile[i]<>bs_decodeascii[i] then
            Writeln('Eingabe[',i,'] = ',zeile[i],' (',Copy(bs_code,(i-1)*20+1,20),'),'#13,
                    'Ausgabe[',i,'] = ',bs_decodeascii[i],' (',Copy(bs_ocode,(i-1)*20+1,20),'),');
      end
  end;

begin
end.