Bruch ermitteln

[Amateurprofi]

@jfheins
Ich habe die Prozedur Kettenbruch ausgiebig getestet.
Da die Prozedur in einem anderen Thread liegt, stelle ich sie hier noch einmal rein.

Delphi-Quellcode:

procedure Kettenbruch (var z1,z2:Int64; Ebenen:Byte);
var
   Ganzzahl, Zaehler, Nenner: Int64;
begin
   z1 := abs(z1);
   z2 := abs(z2);
   Ganzzahl:=z1 div z2;
   Zaehler:=z1-(Ganzzahl*z2);
   Nenner:=z2;
   // Falls die angegebene Tiefe erreicht ist, oder der Ausgangsbruch vollständig
   // angenähert wurde, wird der gemischte Bruch auf einen unechten X/1 Bruch
   // gerundet.
   if (Ebenen=0) or (Zaehler=0) then begin
     Zaehler:=Ganzzahl+Round(Zaehler/Nenner);
     Nenner:=1;
   end else begin
     // Rekusion mit dem Kehrwert des Bruches aus dem gem. Bruch;
     // gem. Bruch > unechter Bruch
     Kettenbruch(Nenner,Zaehler,Ebenen-1);
     Zaehler:=Zaehler+(Ganzzahl*Nenner);
   end;
   z1:=Zaehler;
   z2:=Nenner;
end;

Hauptproblem war für mich meine Sonderbedingung, dass Nenner und Zähler Byte-Werte sein müssen.
Das habe ich, so wie in der Prozedur Test1 gezeigt, zu lösen versucht.

Delphi-Quellcode:

// Zeigt für eine FTL/TL die Ergebnisse von "KettenBruch", bei Rechentiefen von 1 bis 10,
// wobei ein Abbruch erfolgt, wenn Zahler oder Nenner größer werden als 255.
PROCEDURE Test1(FTL,TL:Word);
var Depth:Integer; Z,N:Int64; S:String; Z1,N1:Byte; Solved:Boolean;
begin
   S:='FTL: '+IntToStr(FTL)+', TL: '+IntToStr(FTL)+#13;
   Solved:=False;
   Depth:=1;
   repeat
      Z:=TL;
      N:=FTL;
      KettenBruch(Z,N,Depth);
      S:=S+IntToStr(Z)+', '+IntToStr(N)+#13;
      if (Z<256) and (N<256) then begin
         Z1:=Z;
         N1:=N;
         Solved:=True;
      end else begin
         Break;
      end;
      Inc(Depth);
   until Depth=10;
   if Solved then S:=S+'Gelöst Z='+IntToStr(Z1)+' N='+IntToStr(N1)
      else S:=S+'Keine Lösung';
   ClipBoard.AsText:=S;
   ShowMessage(S);
end;

Nach einigen positiven Erfahrungen kam dann die Meldung "Keine Lösung".
Mit der Prozedur Test2 konnte ich prüfen, dass das nicht an einer falschen Abbruchbedingung in Test1 liegt, sondern daran, dass "Kettenbruch" eben keine Byte-Ergebnisse brachte.

Delphi-Quellcode:

// Zeigt für eine FTL/TL die Ergebnisse von "Kettenbruch" bei Rechentiefen von 1 bis 10
// Dient zur Überprüfung ob ein "Keine Lösung" bei Test1 an einer falschen
// Abbruchbedingung liegt.
PROCEDURE Test2(FTL,TL:Word);
var Depth:Integer; Z,N:Int64; S:String;
begin
   S:='FTL: '+IntToStr(FTL)+', TL: '+IntToStr(TL)+#13;
   Depth:=1;
   repeat
      Z:=TL;
      N:=FTL;
      KettenBruch(Z,N,Depth);
      S:=S+IntToStr(Z)+', '+IntToStr(N)+#13;
      Inc(Depth);
   until Depth=10;
   ClipBoard.AsText:=S;
   ShowMessage(S);
end;

Um in Erfahrung zu bringen, ob die Fälle, in denen keine für mich verwertbare Lösung kommt, für mich relevant sind, habe ich dann mit allen Werten FTL von 400 bis 1200 und TL von 1 bis 32767 getestet. (Prozedur Test3 am Ende des Beitrags).

Das Ergebnis:

Code:

Größte absolute Differenz=144, FTL=505, TL=32681
Größte prozentuale Differenz=33.33, FTL=401, TL=3
Keine Lösung in:
   Total: 2298539 von 26246367 Fällen (=  8.76%)
   Min:   1726 von 32767 Fällen (=  5.27%)
   Max:   5210 von 32767 Fällen (= 15.90%)
   Avg:   2870 von 32767 Fällen (=  8.76%)

Um keine Fehlinterpretationen aufkommen zu lassen:
"Keine Lösung" heißt hier nicht, dass "Kettenbruch" keine Lösung liefert, sondern dass die gelieferten Werte nicht im Byte-Bereich sind.

Da die größte gefundene Differenz höher ist, als bei meiner in #1 gezeigten Lösung, werde ich also vorerst bei meiner Lösung bleiben.
Zudem hätte ich in den Fällen "Keine Lösung" das Problem, die von "Kettenbruch" gelieferten Resultate in den Byte-Bereich zu bringen, was ja genau das ist, was meine in #1 gezeigte Lösung macht.

Übrigens:
Für die Umwandlung von Dezimalbrüche in Brüche werkelt hier https://www.delphipraxis.net/134885-rechenprogramm.html die folgende Prozedur.
Ich habe die vor langen Jahren gefunden (weiß nicht mehr wo, erinnere mich aber, dass die ursprünglich von HP kommen soll).

Delphi-Quellcode:

PROCEDURE GetFraction(V:Extended; var Numerator,Denominator:Extended);
var A,Y,D0,D1,D2,N0,N1,N2,X0,X1:Extended;
begin
   N0:=0.0;
   D0:=1.0;
   N1:=1.0;
   D1:=0.0;
   N2:=0.0;
   D2:=1.0;
   X1:=1.0;
   X0:=1.0;
   A:=Int(V);
   Y:=V-A;
   while (D0<>0) and (N0/D0<>V) do begin
      N0:=A*N1+N2;
      D0:=A*D1+D2;
      if Y=0 then break;
      A:=Int(X1/Y);
      X1:=Y;
      Y:=X0-A*Y;
      X0:=X1;
      N2:=N1;
      N1:=N0;
      D2:=D1;
      D1:=D0;
   end;
   Numerator:=N0;
   Denominator:=D0;
end;

Delphi-Quellcode:

PROCEDURE Test3(FTL1,FTL2,TL1,TL2:Word);
var
   DeltaPct,WorstDeltaPct:Double;
   Z,N:Int64;
   Depth,FTLCount,TLCount,Cases,NoSolutionCount,TotalNoSolutionCount:Integer;
   FTL,TL,WorstFTL,WorstTL,WorstDelta,Delta,WorstPctFTL,WorstPctTL:Word;
   Z1,N1:Byte;
   Solved:Boolean;
   S,S1,S2:String;
   F:TextFile;
begin
   AssignFile(F,ExtractFilePath(ParamStr(0))+'Log.txt');
   Rewrite(F);
   Writeln(F,' FTL    TL');
   Writeln(F,'---- -----');
   FTLCount:=FTL2-FTL1+1;
   TLCount:=TL2-TL1+1;
   Cases:=FTLCount*TLCount;
   TotalNoSolutionCount:=0;
   WorstDelta:=0;
   WorstDeltaPct:=0;
   for FTL:=FTL1 to FTL2 do begin
      NoSolutionCount:=0;
      for TL:=TL1 to TL2 do begin
         Solved:=False;
         Depth:=1;
         repeat
            Z:=TL;
            N:=FTL;
            KettenBruch(Z,N,Depth);
            if (Z<256) and (N<256) then begin
               Z1:=Z;
               N1:=N;
               Solved:=True;
            end else begin
               Break;
            end;
            Inc(Depth);
         until Depth=10;
         if Solved then begin
            Delta:=Abs(TL-FTL*Z1 div N1);
            if Delta>WorstDelta then begin
               WorstFTL:=FTL;
               WorstTL:=TL;
               WorstDelta:=Delta;
            end;
            DeltaPct:=Delta*100/TL;
            if DeltaPct>WorstDeltaPct then begin
               WorstDeltaPct:=DeltaPct;
               WorstPctFTL:=FTL;
               WorstPctTL:=TL;
            end;
         end else begin
            Inc(NoSolutionCount);
            Writeln(F,FTL:4,TL:6);
         end;
      end;
      Inc(TotalNoSolutionCount,NoSolutionCount);
      Writeln(F,'Keine Lösung in ',NoSolutionCount,' von ',TLCount,' Fällen');
      Writeln(F);
   end;
   Writeln(F,'Keine Lösung in ',TotalNoSolutionCount,' von ',Cases,' Fällen');
   Writeln(F);
   CloseFile(F);
   Str(WorstDeltaPct:0:2,S1);
   Str(TotalNoSolutionCount*100/Cases:0:2,S2);
   S:='Größte absolute Differenz='+IntToStr(WorstDelta)+
      ', FTL='+IntToStr(WorstFTL)+', TL='+IntToStr(WorstTL)+#13+
      'Größte prozentuale Differenz='+S1+
      ', FTL='+IntToStr(WorstPctFTL)+', TL='+IntToStr(WorstPctTL)+#13+
      'Keine Lösung in '+IntToStr(TotalNoSolutionCount)+' von '+
      IntToStr(Cases)+' Fällen (='+S2+'%)';
   ClipBoard.AsText:=S;
   ShowMessage(S);
end;