|
![]() |
|
Registriert seit: 17. Nov 2005 Ort: Hamburg 1.111 Beiträge Delphi XE2 Professional |
#1
@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:
Hauptproblem war für mich meine Sonderbedingung, dass Nenner und Zähler Byte-Werte sein müssen.
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; Das habe ich, so wie in der Prozedur Test1 gezeigt, zu lösen versucht.
Delphi-Quellcode:
Nach einigen positiven Erfahrungen kam dann die Meldung "Keine Lösung".
// 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; 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:
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).
// 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; Das Ergebnis:
Code:
Um keine Fehlinterpretationen aufkommen zu lassen:
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%) "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 ![]() 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;
Gruß, Klaus
Die Titanic wurde von Profis gebaut, die Arche Noah von einem Amateur. ... Und dieser Beitrag vom Amateurprofi.... |
![]() |
Registriert seit: 10. Jun 2004 Ort: Garching (TUM) 4.579 Beiträge |
#2
Moin 😀
Auch wenn der Code etwas älter ist, freut es mich wenn ich da Denkanstöße geben konnte. Aber eine Idee hab ich noch: Falls du die Werte wirklich auf Bytes limitieren kannst, würde ich das einfach im voraus berechnen. Also bei Programmstart eine lookup table errechnen (alle gekürzten x/y Brüche mit x, y kleiner 256) und dann eine binäre Suche über das Verhältnis. Dann bekommst du immer das perfekte Ergebnis 😉 Die Tabelle dürfte max 392kB groß sein und sollte in jeden RAM passen... |
![]() |
Registriert seit: 17. Nov 2005 Ort: Hamburg 1.111 Beiträge Delphi XE2 Professional |
#3
Moin 😀
Auch wenn der Code etwas älter ist, freut es mich wenn ich da Denkanstöße geben konnte. Aber eine Idee hab ich noch: Falls du die Werte wirklich auf Bytes limitieren kannst, würde ich das einfach im voraus berechnen. Also bei Programmstart eine lookup table errechnen (alle gekürzten x/y Brüche mit x, y kleiner 256) und dann eine binäre Suche über das Verhältnis. Dann bekommst du immer das perfekte Ergebnis 😉 Die Tabelle dürfte max 392kB groß sein und sollte in jeden RAM passen... Danke für den Hinweis. Ich hab das realisiert, allerdings etwas anders als von dir (vermutlich) gedacht. Ich hab eine Tabelle:
Delphi-Quellcode:
Die Erstellung erfolgt so:
type
TTLEntry=Record Numerator:Byte; Denominator:Byte; TL:Word; End; TTLTable=Array of TTLEntry; 1) Alle unkürzbaren Brüche (GGT(Z,N)=1)) mit Z und N von 1..255, bei denen FLT*Z div N im Bereich 1..32761 ist, mit resultierender TL in die Tabelle stellen. 2) Mehrfachnennungen (gleiche TL) entfernen 3) Für alle TL von 1..32767 prüfen ob die TL in der Tabelle enthalten ist. Wenn nicht, dann vom nächstkleineren und nächstgrößeren Eintrag den besser geeigneten unter neuer TL hinzufügen. 4) Einen Dummy für TL 0 hinzufügen. 5) Tabelle nach TL aufsteigend sortieren. Jetzt kann für jede TL im Bereich 1..32767 mit TLTable[TL].Numerator bzw. .Denominator der Zähler und Nenner geholt werden. Die Tabelle hat während der Erstellung 262 und nach Fertigstellung 131 kB. Die größte Abweichung zwischen TL und der aus FTL, und Zähler/Nenner resultierenden TL ist 2.28 %. Die Erstellung dauert ca. 10 ms. Da bei meinem Anwendungsfall während der Zeit, in der die Tabelle benötigt wird, die FTL konstant bleibt, ist die Erstellung "on demand" deshalb unkritisch. Zu ![]() Die Tabelle dürfte max 392kB groß sein und sollte in jeden RAM passen
Was mich interessieren würde: Wie kamst Du auf max 392kB ?
Delphi-Quellcode:
type
TTLEntry=Record Numerator:Byte; Denominator:Byte; TL:Word; End; TTLTable=Array of TTLEntry; var TLTable:TTLTable; PROCEDURE CreateTLTable(FTL:Word); FUNCTION LCD(A,B:Byte):Byte; var C:Byte; begin repeat C:=A mod B; A:=B; B:=C; until C=0; Result:=A; end; FUNCTION InitTable:Integer; var N,D:Byte; XTL:Integer; begin SetLength(TLTable,256*256); Result:=0; for N:=1 to 255 do for D:=1 to 255 do if LCD(N,D)=1 then begin XTL:=FTL*N div D; if InRange(XTL,1,$7FFF) then with TLTable[Result] do begin Numerator:=N; Denominator:=D; TL:=XTL; Inc(Result); end; end; end; PROCEDURE SortTable(Count:Integer); var M:Word; H:TTLEntry; PROCEDURE QSort(First,Last:Integer); var I,J:Integer; begin I:=First; J:=Last; M:=TLTable[(First+Last) shr 1].TL; repeat while TLTable[I].TL<M do Inc(I); while TLTable[J].TL>M do Dec(J); if I<=J then begin H:=TLTable[I]; TLTable[I]:=TLTable[J]; TLTable[J]:=H; Inc(I); Dec(J); end; until I>J; if J>First then QSort(First,J); if I<Last then QSort(I,Last); end; begin QSort(0,Count-1); end; FUNCTION MakeTableUnique(Count:Integer):Integer; var I:Integer; begin SortTable(Count); Result:=0; for I:=1 to Count-1 do if TLTable[I].TL<>TLTable[Result].TL then begin Inc(Result); TLTable[Result]:=TLTable[I]; end; Inc(Result); end; FUNCTION IsBetter(const A,B:TTLEntry; TL:Word):Boolean; begin Result:=Abs(TL-A.TL)<Abs(TL-B.TL); end; PROCEDURE CompleteTable(Count:Integer); var I,J,L:Integer; N:Word; begin L:=Count; I:=0; for N:=1 to $7FFF do begin while (I<L) and (TLTable[I].TL<N) do Inc(I); // I auf ersten Eintrag mit TL>=N if I>=L then J:=L-1 // Letzten Eintrag hinzufügen else if TLTable[I].TL=N then J:=-1 // Nichts hinzufügen else if I=0 then J:=I // Eintrag I hinzufügen else if IsBetter(TLTable[I],TLTable[I-1],N) then J:=I else J:=I-1; if J>=0 then begin TLTable[Count]:=TLTable[J]; TLTable[Count].TL:=N; Inc(Count); end; end; with TLTable[Count] do begin Numerator:=0; Denominator:=1; TL:=0; end; Inc(Count); SetLength(TLTable,Count); SortTable(Count); end; var Count:Integer; begin Count:=InitTable; Count:=MakeTableUnique(Count); CompleteTable(Count); end;
Gruß, Klaus
Die Titanic wurde von Profis gebaut, die Arche Noah von einem Amateur. ... Und dieser Beitrag vom Amateurprofi.... |
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |