Recent

Author Topic: Add "ROUNDUP" formula and correct "ROUNDDOWN" formula  (Read 1043 times)

veb86

  • Jr. Member
  • **
  • Posts: 62
Add "ROUNDUP" formula and correct "ROUNDDOWN" formula
« on: May 28, 2024, 01:43:17 pm »
Hello
I added rounding up. I provide the code here and in the file:
Code: Pascal  [Select][+][-]
  1. INT_EXCEL_SHEET_FUNC_ROUNDUP    = 212;  // not available in BIFF2
  2.  
  3. AddFunction(cat, 'ROUNDUP',   'F', 'FF',   INT_EXCEL_SHEET_FUNC_ROUNDUP,    @fpsROUNDUP);
  4.  
  5. function MyRoundUp(const AValue: Double; const Digits: TRoundToRange): Double;
  6. var
  7.   RV,FValue,tmp,integral: Double;
  8. begin
  9.  
  10.   FValue := ABS(AValue);
  11.   RV := IntPower(10, Digits);
  12.   tmp := FValue * RV;
  13.   integral := Int(tmp);
  14.   if ((Frac(tmp)/RV)<1e-12) then
  15.      tmp := integral
  16.   else
  17.      tmp := integral +1;
  18.   Result := ABS(tmp/RV)*sign(AValue);
  19. end;  
  20.  
  21. { The Excel ROUNDUP function returns a number rounded UP to a given number
  22.   of decimal places. Unlike standard rounding, where only numbers less than 5
  23.   are rounded UP, ROUNDUP rounds all numbers up. }
  24. procedure fpsROUNDUP(var Result: TsExpressionResult; const Args: TsExprParameterArray);
  25. var
  26.   x: TsExprFloat;
  27.   n: Integer;
  28. begin
  29.   x := ArgToFloat(Args[1]);
  30.   if IsNaN(x) then
  31.     Result := ErrorResult(errWrongType)
  32.   else begin
  33.     n := Round(x);
  34.     x := ArgToFloat(Args[0]);
  35.     if IsNaN(x) then
  36.       Result := ErrorResult(errWrongType)
  37.     else
  38.       Result := FloatResult(MyRoundUp(x, n));
  39.   end;
  40. end;  
  41.  

Correct rounding down:
Now this is the code
Code: Pascal  [Select][+][-]
  1. AddFunction(cat, 'ROUNDDOWN', 'F', 'F',   INT_EXCEL_SHEET_FUNC_ROUNDDOWN,  @fpsROUNDDOWN); << this formula was not read
  2.  
Need this code:
Code: Pascal  [Select][+][-]
  1. AddFunction(cat, 'ROUNDDOWN', 'F', 'FF',   INT_EXCEL_SHEET_FUNC_ROUNDDOWN,  @fpsROUNDDOWN);

Now this is the code
Code: Pascal  [Select][+][-]
  1. function MyRoundDown(const AValue: Double; const Digits: TRoundToRange): Double;
  2. var
  3.   RV: Double;
  4. begin
  5.   RV := IntPower(10, Digits);
  6.   Result := Trunc(AValue / RV) * RV;
  7. end;
  8.  
  9.  
  10. { The Excel ROUNDDOWN function returns a number rounded down to a given number
  11.   of decimal places. Unlike standard rounding, where only numbers less than 5
  12.   are rounded down, ROUNDDOWN rounds all numbers down. }
  13. procedure fpsROUNDDOWN(var Result: TsExpressionResult; const Args: TsExprParameterArray);
  14. var
  15.   x: TsExprFloat;
  16.   n: Integer;
  17. begin
  18.   x := ArgToFloat(Args[1]);
  19.   if IsNaN(x) then
  20.     Result := ErrorResult(errWrongType)
  21.   else begin
  22.     n := Round(x);
  23.     x := ArgToFloat(Args[0]);
  24.     if IsNaN(x) then
  25.       Result := ErrorResult(errWrongType)
  26.     else
  27.       Result := FloatResult(MyRoundDown(x, -n));
  28.   end;
  29. end;  
  30.  
ROUNDDOWN(1.15,2) >> 1.14, but it should have been 1.15

I corrected the code, you need to do this:
Code: Pascal  [Select][+][-]
  1. function MyRoundDown(const AValue: Double; const Digits: TRoundToRange): Double;
  2. var
  3.   RV,FValue,tmp,integral: Double;
  4. begin
  5.  
  6.   FValue := ABS(AValue);
  7.   RV := IntPower(10, Digits);
  8.   tmp := FValue * RV;
  9.   integral := Int(tmp);
  10.   if (((1-Frac(tmp))/RV)<1e-12) then
  11.      tmp := integral +1
  12.   else
  13.      tmp := integral;
  14.   Result := ABS(tmp/RV)*sign(AValue);
  15. end;  
  16.  
  17. procedure fpsROUNDDOWN(var Result: TsExpressionResult; const Args: TsExprParameterArray);
  18. var
  19.   x: TsExprFloat;
  20.   n: Integer;
  21. begin
  22.   x := ArgToFloat(Args[1]);
  23.   if IsNaN(x) then
  24.     Result := ErrorResult(errWrongType)
  25.   else begin
  26.     n := Round(x);
  27.     x := ArgToFloat(Args[0]);
  28.     if IsNaN(x) then
  29.       Result := ErrorResult(errWrongType)
  30.     else
  31.       Result := FloatResult(MyRoundDown(x, n));  << n - without minus
  32.   end;
  33. end;
  34.  
  35.  

I checked the results of the function, everything matches

Please add to the project. For convenience, I am adding the file pas

wp

  • Hero Member
  • *****
  • Posts: 12476
Re: Add "ROUNDUP" formula and correct "ROUNDDOWN" formula
« Reply #1 on: May 28, 2024, 05:13:18 pm »
Thank you. Added to the svn version.

 

TinyPortal © 2005-2018