From 4a45218c8fab87276a774b508d62d2f98e2e83db Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Tue, 19 May 2015 10:55:18 +0000 Subject: [PATCH] fpspreadsheet: More robust float-to-fraction conversion of float. Add test cases for this conversion. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4144 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/fpspreadsheet/fpsutils.pas | 34 ++++++----- .../fpspreadsheet/tests/internaltests.pas | 60 +++++++++++++++++-- 2 files changed, 73 insertions(+), 21 deletions(-) diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index 684eb1d73..6416ae741 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/components/fpspreadsheet/fpsutils.pas @@ -127,8 +127,8 @@ procedure MakeTimeIntervalMask(Src: String; var Dest: String); function ConvertFloatToStr(AValue: Double; AParams: TsNumFormatParams; AFormatSettings: TFormatSettings): String; -procedure FloatToFraction(AValue, APrecision: Double; - AMaxNumerator, AMaxDenominator: Int64; out ANumerator, ADenominator: Int64); +procedure FloatToFraction(AValue: Double; AMaxDenominator: Int64; + out ANumerator, ADenominator: Int64); function TryStrToFloatAuto(AText: String; out ANumber: Double; out ADecimalSeparator, AThousandSeparator: Char; out AWarning: String): Boolean; function TryFractionStrToFloat(AText: String; out ANumber: Double; @@ -1385,13 +1385,12 @@ end; numerator and denominator. @param AValue Floating point value to be analyzed - @param AMaxNumerator Maximum value of the numerator allowed @param AMaxDenominator Maximum value of the denominator allowed @param ANumerator (out) Numerator of the best approximating fraction @param ADenominator (out) Denominator of the best approximating fraction -------------------------------------------------------------------------------} -procedure FloatToFraction(AValue, APrecision: Double; - AMaxNumerator, AMaxDenominator: Int64; out ANumerator, ADenominator: Int64); +procedure FloatToFraction(AValue: Double; AMaxDenominator: Int64; + out ANumerator, ADenominator: Int64); // Uses method of continued fractions, adapted version from a function in // Bart Broersma's fractions.pp unit: // http://svn.code.sf.net/p/flyingsheep/code/trunk/ConsoleProjecten/fractions/ @@ -1400,12 +1399,10 @@ const MinInt64 = Low(Int64); var H1, H2, K1, K2, A, NewA, tmp, prevH1, prevK1: Int64; - B, diff, test: Double; + B, test, diff, prevdiff: Double; PendingOverflow: Boolean; i: Integer = 0; begin - Assert((APrecision > 0) and (APrecision < 1)); - if (AValue > MaxInt64) or (AValue < MinInt64) then raise Exception.Create('Range error'); @@ -1424,6 +1421,7 @@ begin NewA := Round(Floor(B)); prevH1 := H1; prevK1 := K1; + prevdiff := 1E308; repeat inc(i); A := NewA; @@ -1435,9 +1433,11 @@ begin K2 := tmp; test := H1/K1; diff := test - AValue; - if (abs(diff) < APrecision) then - break; - if (abs(H1) >= AMaxNumerator) or (abs(K1) >= AMaxDenominator) then + { Use the previous result if the denominator becomes larger than the allowed + value, or if the difference becomes worse because the "best" result has + been missed due to rounding error - this is more stable than using a + predefined precision in comparing diff with zero. } + if (abs(K1) >= AMaxDenominator) or (abs(diff) > abs(prevdiff)) then begin H1 := prevH1; K1 := prevK1; @@ -1454,6 +1454,7 @@ begin NewA := Round(Floor(B)); prevH1 := H1; prevK1 := K1; + prevdiff := diff; until PendingOverflow; ANumerator := H1; ADenominator := K1; @@ -2794,7 +2795,7 @@ var sfrint, sfrnum, sfrdenom: String; sfrsym, sintnumspace, snumsymspace, ssymdenomspace: String; i, numEl: Integer; - prec: Double; + //prec: Double; begin sintnumspace := ''; snumsymspace := ''; @@ -2802,7 +2803,8 @@ begin sfrsym := '/'; if ADigits >= 0 then begin maxDenom := Round(IntPower(10, ADigits)); - prec := 0.5/maxDenom; + // prec := 0.5/maxDenom; + //prec := 0.001/maxDenom; end; numEl := Length(AElements); @@ -2816,7 +2818,8 @@ begin end else frint := 0; if ADigits >= 0 then - FloatToFraction(AValue, prec, MaxInt, maxdenom, frnum, frdenom) + FloatToFraction(AValue, maxdenom, frnum, frdenom) +// FloatToFraction(AValue, prec, MaxInt, maxdenom, frnum, frdenom) else begin frdenom := -ADigits; @@ -2834,7 +2837,8 @@ begin // "normal" fraction sfrint := ''; if ADigits > 0 then - FloatToFraction(AValue, prec, MaxInt, maxdenom, frnum, frdenom) +// FloatToFraction(AValue, prec, MaxInt, maxdenom, frnum, frdenom) + FloatToFraction(AValue, maxdenom, frnum, frdenom) else begin frdenom := -ADigits; diff --git a/components/fpspreadsheet/tests/internaltests.pas b/components/fpspreadsheet/tests/internaltests.pas index beb543a02..30c33343f 100644 --- a/components/fpspreadsheet/tests/internaltests.pas +++ b/components/fpspreadsheet/tests/internaltests.pas @@ -32,6 +32,8 @@ type procedure SetUp; override; procedure TearDown; override; + procedure FractionTest(AMaxDigits: Integer); + published // Tests getting Excel style A1 cell locations from row/column based locations. // Bug 26447 @@ -52,11 +54,17 @@ type procedure TestReadBufStream; procedure TestWriteBufStream; // Test fractions - procedure FractionTest; +// procedure FractionTest_0; + procedure FractionTest_1; + procedure FractionTest_2; + procedure FractionTest_3; end; implementation +uses + Math; + const InternalSheet = 'Internal'; //worksheet name @@ -397,26 +405,66 @@ begin CheckEquals(s, GetCellString(r, c, flags)); end; -procedure TSpreadInternalTests.FractionTest; +procedure TSpreadInternalTests.FractionTest(AMaxDigits: Integer); const N = 300; - DIGITS = 3; var - i, j: Integer; + j: Integer; sollNum, sollDenom: Integer; sollValue: Double; actualNum, actualDenom: Int64; + max: Integer; + prec: Double; +begin + max := Round(IntPower(10, AMaxDigits)); + prec := 0.001/max; + for sollDenom := 1 to max-1 do + for sollNum := 1 to sollDenom-1 do begin + sollValue := StrToFloat(FormatFloat('0.000000000', sollNum/sollDenom)); + FloatToFraction(sollValue, max, actualNum, actualDenom); + //FloatToFraction(sollValue, prec, max, max, actualNum, actualDenom); + if (actualnum*solldenom div actualdenom <> sollnum) then + fail(Format('Conversion error: %g = %d/%d turns to %d/%d (=%g)', [sollValue, sollNum, sollDenom, actualNum, actualDenom, actualNum/actualdenom])); + end; +end; + (* +procedure TSpreadInternalTests.FractionTest_0; +const + N = 300; +var + j: Integer; + sollNum, sollDenom: Integer; + sollvalue: Double; + actualNum, actualDenom: Int64; begin sollNum := 1; for j := 1 to N do begin sollDenom := j; - sollValue := StrToFloat(FormatFloat('0.00000', sollNum/sollDenom)); - FloatToFraction(sollvalue, 0.1/DIGITS, DIGITS, DIGITS, actualNum, actualDenom); +// sollValue := StrToFloat(FormatFloat('0.00000', sollNum/sollDenom)); + sollValue := 1.0/sollDenom; +// FloatToFraction(sollvalue, 0.1/DIGITS, DIGITS, DIGITS, actualNum, actualDenom); + FloatToFraction(sollvalue, 1000, actualNum, actualDenom); if actualDenom > sollDenom then fail(Format('Conversion error: approximated %d/%d turns to %d/%d', [sollNum, sollDenom, actualNum, actualDenom])); end; end; +*) + +procedure TSpreadInternalTests.FractionTest_1; +begin + FractionTest(1); +end; + +procedure TSpreadInternalTests.FractionTest_2; +begin + FractionTest(2); +end; + +procedure TSpreadInternalTests.FractionTest_3; +begin + FractionTest(3); +end; procedure TSpreadInternalTests.SetUp; begin