Recent

Author Topic: RoundTo and CompareValue in 2.0  (Read 2698 times)

jbmckim

  • Full Member
  • ***
  • Posts: 139
RoundTo and CompareValue in 2.0
« on: January 17, 2020, 01:27:08 am »
Just upgraded to 2.0 from 1.8. 

It looks like the currency type is no longer is accepted as parameters by CompareValue and RoundTo (?).  At least my code does not compile (colorunit.pas(1322,14) Error: Can't determine which overloaded function to call).    I understand CompareValue but why RoundTo?  That seems like a function you'd want to have for currency.  I realize I can write my own but why go to the trouble of removing something useful?  Hopefully I'm missing something.

Thanks.

jamie

  • Hero Member
  • *****
  • Posts: 3664
Re: RoundTo and CompareValue in 2.0
« Reply #1 on: January 17, 2020, 03:37:36 am »
I never knew it did that in the first place, maybe you got lucky ?

In any case, do as I did, I write a Currency Helper so that you can simply use the DOT extension.

 MyCurrency,.RoundT0(NUmberof digits)

 if you need help writing that just ask.

The only true wisdom is knowing you know nothing

PascalDragon

  • Hero Member
  • *****
  • Posts: 2262
  • Compiler Developer
Re: RoundTo and CompareValue in 2.0
« Reply #2 on: January 17, 2020, 09:27:05 am »
Just upgraded to 2.0 from 1.8. 

It looks like the currency type is no longer is accepted as parameters by CompareValue and RoundTo (?).  At least my code does not compile (colorunit.pas(1322,14) Error: Can't determine which overloaded function to call).    I understand CompareValue but why RoundTo?  That seems like a function you'd want to have for currency.  I realize I can write my own but why go to the trouble of removing something useful?  Hopefully I'm missing something.
Can it be that you also changed your Lazarus from Windows 32-bit to Windows 64-bit? Cause on Windows 64-bit Currency internally is essentially an "Int64" while on non-Win64 x86 it's a type provided on the x87 FPU. The RoundTo function only provides overloads for Single, Double and Extended while CompareValue also provides overloads for e.g. QWord and Int64. Due to the nature of Currency can not determine which overload you want to use by itself. So you need to manually cast the values to the type you want to handle (e.g. by using Extended(YourValue)).

BrunoK

  • Sr. Member
  • ****
  • Posts: 267
  • Retired programmer
Re: RoundTo and CompareValue in 2.0
« Reply #3 on: January 17, 2020, 02:50:13 pm »
As part of efforts to get Currency to work correctly on CPU64 this is a bit of code I'm experimenting in this regard.

It implements  RoundTo, Ceil and Trunc for currency and doesn't use any floating point instructions.

Not yet durably tested.


jbmckim

  • Full Member
  • ***
  • Posts: 139
Re: RoundTo and CompareValue in 2.0
« Reply #4 on: January 17, 2020, 10:42:28 pm »
Hi Jamie,

Would you mind posting an example of your .RoundTo function here?  That way both your approach and Bruno's will be available in one place.

Thanks.

jamie

  • Hero Member
  • *****
  • Posts: 3664
Re: RoundTo and CompareValue in 2.0
« Reply #5 on: January 17, 2020, 11:52:14 pm »
not sure if the digit count is correct but experiment with this helper, you can add to it also.
Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4. {$modeswitch typehelpers}
  5.  
  6. interface
  7.  
  8. uses
  9.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;
  10.  
  11. type
  12.   TCurrencyHelper = Type helper for Currency
  13.    Function RoundTo(ANumberOfDigits:Integer):Currency;
  14.    Function ToString:String;
  15.  
  16.   End;
  17.  
  18.   { TForm1 }
  19.  
  20.   TForm1 = class(TForm)
  21.     Button1: TButton;
  22.     procedure Button1Click(Sender: TObject);
  23.   private
  24.  
  25.   public
  26.  
  27.   end;
  28.  
  29. var
  30.   Form1: TForm1;
  31.  
  32. implementation
  33.  
  34. {$R *.lfm}
  35.  
  36. { TForm1 }
  37.  
  38. procedure TForm1.Button1Click(Sender: TObject);
  39. Var
  40.   C:Currency;
  41. begin
  42.   C := 1.1354;
  43.   Caption := C.RoundTo(2).Tostring;
  44. end;
  45.  
  46. Function TCurrencyHelper.RoundTo(ANumberOfDigits:Integer):Currency;
  47. Var
  48.   F:Double;
  49.   P:Double;
  50. Begin
  51.    F := Self;
  52.    P := Exp(AnumberOfDigits*ln(10));
  53.    F :=F*P;
  54.    F := Round(F);
  55.    F := F / P;
  56.   Result := F;
  57. end;
  58. Function TCurrencyHelper.ToString:String;
  59. Begin
  60.  Result := CurrToStr(Self);
  61. End;
  62.  
  63. end.
  64.  
  65.  
The only true wisdom is knowing you know nothing

jamie

  • Hero Member
  • *****
  • Posts: 3664
Re: RoundTo and CompareValue in 2.0
« Reply #6 on: January 18, 2020, 12:14:33 am »
I have modified the RoundTo which uses a system.Round(Currency) so it maybe more accurate..

Code: Pascal  [Select][+][-]
  1. Function TCurrencyHelper.RoundTo(ANumberOfDigits:Integer):Currency; inline;
  2. Var
  3.   P:Double;
  4. Begin
  5.    P := Exp(AnumberOfDigits*ln(10));
  6.    Self :=Self*P;
  7.    Self:= Round(Self);
  8.    Self := Self / P;
  9.   Result := Self;
  10. end;                    
  11.  
The only true wisdom is knowing you know nothing

BrunoK

  • Sr. Member
  • ****
  • Posts: 267
  • Retired programmer
Re: RoundTo and CompareValue in 2.0
« Reply #7 on: January 18, 2020, 11:18:01 am »
Code: Pascal  [Select][+][-]
  1. Function TCurrencyHelper.RoundTo(ANumberOfDigits:Integer):Currency; inline;
  2. Var
  3.   P:Double;
  4. Begin
  5.    P := Exp(AnumberOfDigits*ln(10));
  6.    Self :=Self*P;
  7.    Self:= Round(Self);
  8.    Self := Self / P;
  9.   Result := Self;
  10. end;                    
  11.  
I tried it but it doesn't seem to give correct result ...

jamie

  • Hero Member
  • *****
  • Posts: 3664
Re: RoundTo and CompareValue in 2.0
« Reply #8 on: January 18, 2020, 03:12:46 pm »
Can you elaborate more on the results?

 Are you referring to the change I  made or the overall code in general ?

 I did this with the 64 bit 3.0.4.

 Maybe I don't understand what Roundto is suppose to do? I could have that wrong but it would be nice if you could supply some samples and results that fails, just a couple here would be nice so I can see what is to be expected.

  On my end and the few I tested, both versions produce the same results.

The only true wisdom is knowing you know nothing

BrunoK

  • Sr. Member
  • ****
  • Posts: 267
  • Retired programmer
Re: RoundTo and CompareValue in 2.0
« Reply #9 on: January 18, 2020, 05:15:22 pm »
It should, as I understand it and implemented in a previous message do the following thing:

Code: Pascal  [Select][+][-]
  1. Function spec : RoundTo(aCurr:Currency; aDecPlaces : integer[-3..14]):currency;                                
  2.  
  3. aCurr            aDecPlaces               Result
  4. 922337203685477.5794     -3 922337203685477.5790  Down relative to -4
  5. 922337203685477.5794     -2 922337203685477.5800  Up relative to -3
  6. 922337203685477.5794     -1 922337203685477.6000  Up relative to -2
  7. 922337203685477.5794      0 922337203685478.0000  Up relative to -1
  8.  
  9. 922337203685477.5794      4 922337203685000.0000  Down relative to  3 (477.5794 < 500.0000)
  10.  
  11. 922337203685477.5794      6 922337203690000.0000
  12.  
  13. 922337203685477.5794     14 900000000000000.0000
  14.  

jamie

  • Hero Member
  • *****
  • Posts: 3664
Re: RoundTo and CompareValue in 2.0
« Reply #10 on: January 18, 2020, 11:13:44 pm »
I've been playing today with some currency between fpc/laz and Delphi. It seems  they both suffer from problems with large currency values. At lease in 3.0.4 64bit..

 I've also found that parsing the large value via constant does not translate to a correct value in the end..

 I thought the currency type was a Int64  in the background ?

 I've also notice after looking at the asm code, you can't even CAST over it with bin types without the compiler performing conversions. That at least does not happen with my old Delphi, there I can cast it to the bin image.

 Maybe its time to write a fixed point library.. there Is already a FixedPoint record in the windows unit..
The only true wisdom is knowing you know nothing

jamie

  • Hero Member
  • *****
  • Posts: 3664
Re: RoundTo and CompareValue in 2.0
« Reply #11 on: January 19, 2020, 01:57:38 am »
ok, did some tinkering and come up with this...
Code: Pascal  [Select][+][-]
  1. function TCurrencyHelper.RoundTo(ANumberOfDigits: integer): currency;
  2. var
  3.   P: integer;
  4.   M: integer;
  5.   I: int64;
  6. begin
  7.   Result := Self;
  8.   ANumberOfDigits := 3 - AnumberOfDigits;
  9.   if ANumberofDigits < 0 then
  10.     Exit; { Limit the fraction }
  11.   I := PUInt64(@Self)^;
  12.   P := Trunc(Exp(AnumberOfDigits * ln(10)));
  13.   I := I div P;
  14.   M := I mod 10;
  15.   if M >= 5 then
  16.     I := I + 10;
  17.   I := I - M;
  18.   I := I * P;
  19.   Result := currency(Pointer(@I)^);
  20. end;                                        
  21.  

As you can see I found a way around the compiler doing auto conversion to integers and removing the fraction on me, that wasn't nice of the compiler to do that  >:(

  I follow some guide lines of Excel using sites like this one
https://exceljet.net/excel-functions/excel-round-function

 Because I am really not a paper pusher!  ;D

 I haven't yet done the large values but they should work because there is no overflow taking place to the left.

« Last Edit: January 19, 2020, 02:05:08 am by jamie »
The only true wisdom is knowing you know nothing

jamie

  • Hero Member
  • *****
  • Posts: 3664
Re: RoundTo and CompareValue in 2.0
« Reply #12 on: January 19, 2020, 02:31:11 am »
I found a couple of boo boo's in my code...

First I wasn't ensuring a valid output if it aborted early, that's fixed

Then I didn't account for negative numbers , that is now fixed...
Code: Pascal  [Select][+][-]
  1. function TCurrencyHelper.RoundTo(ANumberOfDigits: integer): currency;
  2. var
  3.   P: integer;
  4.   M: integer;
  5.   I: int64;
  6.   N:Boolean;
  7. begin
  8.   Result := Self;
  9.   ANumberOfDigits := 3 - AnumberOfDigits;
  10.   if ANumberofDigits < 0 then
  11.     Exit; { Limit the fraction }
  12.   N := Self < 0; // is it negetive ?
  13.   I := Abs(PInt64(@Self)^);
  14.   P := Trunc(Exp(AnumberOfDigits * ln(10)));
  15.   I := I div P;
  16.   M := I mod 10;
  17.   if M >= 5 then
  18.     I := I + 10;
  19.   I := I - M;
  20.   I := I * P;
  21.   Result := currency(Pointer(@I)^);
  22.   If N THen Result := -Result;
  23. end;                                  
  24.  
The only true wisdom is knowing you know nothing

BrunoK

  • Sr. Member
  • ****
  • Posts: 267
  • Retired programmer
Re: RoundTo and CompareValue in 2.0
« Reply #13 on: January 19, 2020, 02:58:03 pm »
A test program :
Code: Pascal  [Select][+][-]
  1. program Project1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. {$modeswitch typehelpers}
  6.  
  7. uses
  8.   SysUtils, CurrUtil, Math;
  9.  
  10. type
  11.   TCurrencyHelper = type helper for currency
  12.     function RoundTo(ANumberOfDigits: integer): currency;
  13.   end;
  14.  
  15. { jamie's RoundTo helper }
  16. function TCurrencyHelper.RoundTo(ANumberOfDigits: integer): currency;
  17. var
  18.   P: LongInt;
  19.   M: integer;
  20.   I: int64;
  21.   N:Boolean;
  22. begin
  23.   Result := Self;
  24.   ANumberOfDigits := 3 - AnumberOfDigits;
  25.   if ANumberofDigits < 0 then
  26.     Exit; { Limit the fraction }
  27.   N := Self < 0; // is it negative ?
  28.   I := Abs(PInt64(@Self)^);
  29.   P := Trunc(Exp(AnumberOfDigits * ln(10)));
  30.   I := I div P;
  31.   M := I mod 10;
  32.   if M >= 5 then
  33.     I := I + 10;
  34.   I := I - M;
  35.   I := I * P;
  36.   Result := currency(Pointer(@I)^);
  37.   If N THen Result := -Result;
  38. end;
  39.  
  40. var
  41.   vCur0, vCur1 : Currency;
  42.   vStr : string;
  43.   vLen : integer;
  44.   i : integer;
  45.  
  46. begin
  47.   PInt64(@vCur0)^ := High(int64) div 29999;
  48.   WriteLn('vCur0=',FormatCurr(',.0000', vCur0));
  49.   WriteLn;
  50.   Str(PInt64(@vCur0)^,vStr);
  51.   vLen := length(vStr);
  52.   for i := vLen - 5 downto -3 do begin
  53.     writeLn(i:2,' jamie RoundTo(',FormatCurr(',.0000',  vCur0):20,')=',FormatCurr(',.0000', vCur0.RoundTo(i)):20, ' jamie');
  54.     writeLn(i:2,' pos   RoundTo(',FormatCurr(',.0000',  vCur0):20,')=',FormatCurr(',.0000', RoundTo( vCur0, i)):20, ' ~bk');
  55.     writeLn(i:2,' neg   RoundTo(',FormatCurr(',.0000', -vCur0):20,')=',FormatCurr(',.0000', RoundTo(-vCur0, i)):20, ' ~bk');
  56.   end;
  57.   writeLn;
  58.   writeLn('pos   TruncCurr(',FormatCurr(',.0000',  vCur0):20,')=',FormatCurr(',.0000', TruncCurr( vCur0)):20);
  59.   writeLn('neg   TruncCurr(',FormatCurr(',.0000', -vCur0):20,')=',FormatCurr(',.0000', TruncCurr(-vCur0)):20);
  60.   writeLn;
  61.   writeLn('pos   CeilCurr(',FormatCurr(',.0000',  vCur0):20,')=',FormatCurr(',.0000', CeilCurr( vCur0)):20);
  62.   writeLn('neg   CeilCurr(',FormatCurr(',.0000', -vCur0):20,')=',FormatCurr(',.0000', CeilCurr(-vCur0)):20);
  63.   { test 0}
  64.   writeLn;
  65.   writeLn(' 0    TruncCurr(',FormatCurr(',.0000',  0):20,')=',FormatCurr(',.0000', TruncCurr( 0)):20);
  66.   writeLn(' 0    CeilCurr(',FormatCurr(',.0000',  0):20,')=',FormatCurr(',.0000', CeilCurr( 0)):20);
  67.  
  68.   ReadLn;
  69. end.
  70.  

CurrUtil : utility unit with Int64 only operations
Code: Pascal  [Select][+][-]
  1. {****************************************************************************
  2. *                                                                           *
  3. *   This file is a companion to the Free Pascal run time library.           *
  4. *   Author : BrunoK on lazarus forum                                        *
  5. *                                                                           *
  6. *   This file contains some helper routines for the currency data type      *
  7. *   that handles RoundTo, Ceil and Trunc both on CPU32 and CPU64.           *
  8. *                                                                           *
  9. *   This code is free software; you can redistribute it and/or modify it.   *
  10. *                                                                           *
  11. *   See the file COPYING.FPC for details about the copyright.               *
  12. *                                                                           *
  13. *   This program is distributed in the hope that it will be useful,         *
  14. *   but WITHOUT ANY WARRANTY; without even the implied warranty of          *
  15. *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                    *
  16. *                                                                           *
  17. *****************************************************************************}
  18.  
  19. unit CurrUtil;
  20.  
  21. {$mode objfpc}{$H+}
  22.  
  23. interface
  24.  
  25. type
  26.   TCurrRoundRange = -3..14;
  27.  
  28. function RoundTo(constref aCurr : Currency; const a10EFact : TCurrRoundRange) : Currency;
  29. function CeilCurr(const aCurr : Currency) : Currency;
  30. function TruncCurr(const aCurr : Currency) : Currency;
  31.  
  32. implementation
  33.  
  34. const
  35.   cModFact:array[TCurrRoundRange] of int64 =
  36.     (10, 100, 1000,    // Decimals
  37.      10000,            // Unit
  38.      100000,           // Powers of 10
  39.      1000000,
  40.      10000000,
  41.      100000000,
  42.      1000000000,
  43.      10000000000,
  44.      100000000000,
  45.      1000000000000,
  46.      10000000000000,
  47.      100000000000000,
  48.      1000000000000000,
  49.      10000000000000000,
  50.      100000000000000000,
  51.      1000000000000000000);
  52.     {9223372036854775807}
  53.  
  54.   c10e4   = 10000;
  55.  
  56. function RoundTo(constref aCurr: Currency; const a10EFact: TCurrRoundRange
  57.   ): Currency;
  58. var
  59.   lInInt64 : Int64 absolute aCurr;
  60.   lResI64 : Int64 absolute result;
  61.   lModFact : Int64;
  62.   lSign : integer;
  63. begin
  64.   lModFact := cModFact[a10EFact];
  65.   lResI64 := lInInt64 mod lModFact;
  66.   if lResI64=0 then
  67.     Result := aCurr
  68.   else begin
  69.     {$PUSH} {$Q+}
  70.     if Abs(lResI64)>=(lModFact shr 1) then begin
  71.       if lResI64>0 then
  72.         lResI64 := (lInInt64 - lResI64) + lModFact  // pos up
  73.       else
  74.         lResI64 := (lInInt64 - lResI64) - lModFact  // minus down
  75.     end
  76.     else
  77.       lResI64 := lInInt64 - lResI64;                // down
  78.     {$POP}
  79.   end;
  80. end;
  81.  
  82. function CeilCurr(const aCurr: Currency): Currency;
  83. var
  84.   lInInt64 : Int64 absolute aCurr;
  85.   lResI64  : Int64 absolute result;
  86. begin
  87.   lResI64 := lInInt64 mod c10E4;
  88.   if lResI64=0 then
  89.     Result := aCurr
  90.   else begin
  91.     {$PUSH} {$Q+}
  92.     if lResI64>0 then
  93.       lResI64 := lInInt64 - lResI64 + c10e4
  94.     else
  95.       lResI64 := lInInt64 - lResI64 - c10e4;
  96.     {$POP}
  97.   end;
  98. end;
  99.  
  100. function TruncCurr(const aCurr: Currency): Currency;
  101. var
  102.   lInInt64 : Int64 absolute aCurr;
  103.   lResI64  : Int64 absolute result;
  104. begin
  105.   lResI64 := lInInt64 mod c10e4;
  106.   if lResI64=0 then begin
  107.     Result := aCurr;
  108.     exit;
  109.   end;
  110.   lResI64 := lInInt64 - lResI64;
  111. end;
  112.  
  113. end.

Some result from the test are counterintuitive but I think they are correct.

jamie

  • Hero Member
  • *****
  • Posts: 3664
Re: RoundTo and CompareValue in 2.0
« Reply #14 on: January 19, 2020, 03:13:03 pm »
I ran a whole test last night against Excel and it seems to be ok so I can stash that in my libs.

 I am currently adding other items to the helper like ModCur, Sums, RoundUp, RoundDown, MRound,
Comparevalues for range between etc..

 All of this so far is done based on the Int64, no Floats..

  But I did notice an issue with the compiler defining a Currency from a constant, it looks like it is actually creating a float first then translating it to a currency which loses precision in the end, where as doing it on an integer level would not do that.

  Maybe I sound look at the existing supplied function as we have it now, the StrToCurr to see how that is doing it... I would wager that it is first converting it to a float which would result in the same defect.

 I am  making a test app for this Helper.. I will post it here for evaluation at some point.
The only true wisdom is knowing you know nothing

 

TinyPortal © 2005-2018