3
3
** REBOL [R3] Language Interpreter and Run-time Environment
4
4
**
5
5
** Copyright 2012 REBOL Technologies
6
+ ** Copyright 2012-2021 Rebol Open Source Contributors
6
7
** REBOL is a trademark of REBOL Technologies
7
8
**
8
9
** Licensed under the Apache License, Version 2.0 (the "License");
22
23
** Module: t-decimal.c
23
24
** Summary: decimal datatype
24
25
** Section: datatypes
25
- ** Author: Carl Sassenrath
26
+ ** Author: Carl Sassenrath, Ladislav Mecir, Oldes
26
27
** Notes:
27
28
**
28
29
***********************************************************************/
@@ -45,22 +46,22 @@ static char *gcvt(double value, int digits, char *buffer)
45
46
46
47
/*
47
48
Purpose: {defines the almost_equal comparison function}
48
- Properties: {
49
+ Properties: {
49
50
since floating point numbers are ordered and there is only
50
51
a finite quantity of floating point numbers, it is possible
51
52
to assign an ordinal (integer) number to any floating point number so,
52
53
that the ordinal numbers of neighbors differ by one
53
-
54
+
54
55
the function compares floating point numbers based on
55
56
the difference of their ordinal numbers in the ordering
56
57
of floating point numbers
57
-
58
+
58
59
difference of 0 means exact equality, difference of 1 means, that
59
60
the numbers are neighbors.
60
61
}
61
62
Advantages: {
62
63
the function detects approximate equality.
63
-
64
+
64
65
the function is more strict in the zero neighborhood than
65
66
absolute-error-based approaches
66
67
@@ -69,15 +70,15 @@ static char *gcvt(double value, int digits, char *buffer)
69
70
meaning that neighbors are deemed equal, max_diff = 10 meaning, that
70
71
the numbers are deemed equal if at most 9
71
72
distinct floating point numbers can be found between them
72
-
73
+
73
74
the max_diff value may be one of the system options specified in
74
75
the system/options object allowing users to exactly define the
75
76
strictness of equality checks
76
77
}
77
78
Differences: {
78
79
The approximate comparison currently used in R3 corresponds to the
79
80
almost_equal function using max_diff = 10 (according to my tests).
80
-
81
+
81
82
The main differences between the currently used comparison and the
82
83
one based on the ordinal number comparison are:
83
84
- the max_diff parameter can be adjusted, allowing
@@ -110,7 +111,7 @@ REBOOL almost_equal(REBDEC a, REBDEC b, REBCNT max_diff) {
110
111
111
112
int_diff = ua .i - ub .i ;
112
113
if (int_diff < 0 ) int_diff = - int_diff ;
113
-
114
+
114
115
return ((REBU64 ) int_diff <= max_diff );
115
116
}
116
117
@@ -339,13 +340,15 @@ REBOOL almost_equal(REBDEC a, REBDEC b, REBCNT max_diff) {
339
340
case A_NEGATE :
340
341
d1 = - d1 ;
341
342
goto setDec ;
343
+
342
344
case A_ABSOLUTE :
343
345
if (d1 < 0 ) d1 = - d1 ;
344
346
goto setDec ;
347
+
345
348
case A_EVENQ :
346
349
case A_ODDQ :
347
350
d1 = fabs (fmod (d1 , 2.0 ));
348
- DECIDE ((action != A_EVENQ ) != (( d1 < 0.5 ) || ( d1 >= 1.5 ) ));
351
+ DECIDE ((action == A_EVENQ ) == ( d1 < 0.5 || d1 >= 1.5 ));
349
352
350
353
case A_MAKE :
351
354
case A_TO :
@@ -364,24 +367,24 @@ REBOOL almost_equal(REBDEC a, REBDEC b, REBCNT max_diff) {
364
367
case REB_PERCENT :
365
368
d1 = VAL_DECIMAL (val );
366
369
goto setDec ;
367
-
370
+
368
371
case REB_INTEGER :
369
372
d1 = (REBDEC )VAL_INT64 (val );
370
373
goto setDec ;
371
-
374
+
372
375
case REB_MONEY :
373
376
d1 = deci_to_decimal (VAL_DECI (val ));
374
377
goto setDec ;
375
-
378
+
376
379
case REB_LOGIC :
377
380
if (action != A_MAKE ) Trap_Make (type , val );
378
381
d1 = VAL_LOGIC (val ) ? 1.0 : 0.0 ;
379
382
goto setDec ;
380
-
383
+
381
384
case REB_CHAR :
382
385
d1 = (REBDEC )VAL_CHAR (val );
383
386
goto setDec ;
384
-
387
+
385
388
case REB_TIME :
386
389
d1 = VAL_TIME (val ) * NANO ;
387
390
break ;
@@ -398,12 +401,12 @@ REBOOL almost_equal(REBDEC a, REBDEC b, REBCNT max_diff) {
398
401
}
399
402
Trap_Make (type , val );;
400
403
}
401
-
404
+
402
405
case REB_BINARY :
403
406
Binary_To_Decimal (val , D_RET );
404
407
d1 = VAL_DECIMAL (D_RET );
405
408
break ;
406
-
409
+
407
410
#ifdef removed
408
411
// case REB_ISSUE:
409
412
{
0 commit comments