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

@@ -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;
+procedure FloatToFraction(AValue: Double; AMaxDenominator: Int64;
-  AMaxNumerator, AMaxDenominator: Int64; out ANumerator, ADenominator: 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;
+procedure FloatToFraction(AValue: Double; AMaxDenominator: Int64;
-  AMaxNumerator, AMaxDenominator: Int64; out ANumerator, ADenominator: 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
+    { Use the previous result if the denominator becomes larger than the allowed
-      break;
+      value, or if the difference becomes worse because the "best" result has
-    if (abs(H1) >= AMaxNumerator) or (abs(K1) >= AMaxDenominator) then
+      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;

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));
+//    sollValue := StrToFloat(FormatFloat('0.00000', sollNum/sollDenom));
-    FloatToFraction(sollvalue, 0.1/DIGITS, DIGITS, DIGITS, actualNum, actualDenom);
+    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