MathgeomGLS

1
{---------------------------------------------------------------------------}
2
{                                                                           }
3
{ File:       Velthuis.ExactFloatStrings.pas                                }
4
{ Function:   Routines to generate strings that contain the exact values    }
5
{             of Singles, Doubles or Extendeds.                             }
6
{ Language:   Delphi version XE3 or later                                   }
7
{ Author:     Rudy Velthuis                                                 }
8
{ Copyright:  (c) 2015, Rudy Velthuis                                       }
9
{ Notes:      Requires the Velthuis.BigIntegers unit                        }
10
{             Requires record helpers for intrinsic types                   }
11
{                                                                           }
12
{ License:    Redistribution and use in source and binary forms, with or    }
13
{             without modification, are permitted provided that the         }
14
{             following conditions are met:                                 }
15
{                                                                           }
16
{             * Redistributions of source code must retain the above        }
17
{               copyright notice, this list of conditions and the following }
18
{               disclaimer.                                                 }
19
{             * Redistributions in binary form must reproduce the above     }
20
{               copyright notice, this list of conditions and the following }
21
{               disclaimer in the documentation and/or other materials      }
22
{               provided with the distribution.                             }
23
{                                                                           }
24
{ Disclaimer: THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER "AS IS"     }
25
{             AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT     }
26
{             LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND     }
27
{             FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO        }
28
{             EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE     }
29
{             FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,     }
30
{             OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,      }
31
{             PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,     }
32
{             DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED    }
33
{             AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT   }
34
{             LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)        }
35
{             ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF   }
36
{             ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.                    }
37
{                                                                           }
38
{---------------------------------------------------------------------------}
39

40
unit Velthuis.ExactFloatStrings;
41

42
interface
43

44
{$IF CompilerVersion >= 24.0}
45
  {$LEGACYIFEND ON}
46
{$IFEND}
47

48
{$IF SizeOf(Extended) > SizeOf(Double)}
49
  {$DEFINE HASEXTENDED}
50
{$IFEND}
51

52
uses
53
  System.SysUtils;
54

55
{$IFDEF HASEXTENDED}
56
function ExactString(const F: Extended): string; overload;
57
{$ENDIF}
58
function ExactString(const F: Double): string; overload;
59
function ExactString(const F: Single): string; overload;
60

61
implementation
62

63
uses
64
  Velthuis.BigIntegers,
65
  Velthuis.FloatUtils,
66
  System.Math;
67

68
// BigIntegers are required to either multiply the mantissa by powers of 5 or by powers of 2 and to
69
// generate a string from the resulting BigInteger.
70
// Record helpers for intrinsics are used to get info out of the floating point types, e.g. IsNan, Mantissa, etc.
71

72
{$IFDEF HASEXTENDED}
73
function ExactString(const F: Extended): string;
74
var
75
  Mantissa: UInt64;
76
  Exponent: Integer;
77
  Sign: Boolean;
78
  BigInt: BigInteger;
79
  DecimalPoint: Integer;
80
  Len: Integer;
81
begin
82
  if System.Math.IsNaN(F) then
83
    Exit('NaN')
84
  else if IsNegativeInfinity(F) then
85
    Exit('NegInfinity')
86
  else if IsPositiveInfinity(F) then
87
    Exit('Infinity');
88

89
  Mantissa := GetSignificand(F);
90
  if Mantissa = 0 then
91
    Exit('0');
92

93
  Exponent := GetExponent(F) - 63;
94
  Sign := System.Math.Sign(F) < 0;
95

96
  while not Odd(Mantissa) do
97
  begin
98
    Mantissa := Mantissa shr 1;
99
    Inc(Exponent);
100
  end;
101

102
  BigInt := Mantissa;
103

104
  DecimalPoint := 0;
105
  if Exponent < 0 then
106
  begin
107
    // BigInt must repeatedly be divided by 2.
108
    // This isn't done directly: On each iteration, BigInt is multiplied by 5 and then the decimal point is moved one
109
    // position to the left, which is equivalent to dividing by 10. This is done in one fell swoop, using Pow().
110
    BigInt := BigInt * BigInteger.Pow(5, -Exponent);
111
    DecimalPoint := -Exponent;
112
  end
113
  else
114
    // BigInt must repeatedly be multipied by 2. This is done in one go, by shifting the BigInteger left by Exponent.
115
    BigInt := BigInt shl Exponent;
116

117
  Result := BigInt.ToString;
118
  Len := Length(Result);
119

120
  // Now we insert zeroes and the decimal point into the plain big integer value to get a nice output.
121

122
  if DecimalPoint = 0 then
123
    Result := Result                                             // e.g. 123.0
124
  else if DecimalPoint >= Len then
125
    Result := '0.' + StringOfChar('0', DecimalPoint - Len) + Result       // e.g. 0.00123
126
  else
127
    Result := Copy(Result, 1, Len - DecimalPoint) + '.' + Copy(Result, Len - DecimalPoint + 1, Len); // e.g. 12.3
128

129
  if Sign then
130
    Result := '-' + Result;
131
end;
132
{$ENDIF}
133

134
function ExactString(const F: Double): string;
135
var
136
  Mantissa: UInt64;
137
  Exponent: Integer;
138
  Sign: Boolean;
139
  BigInt: BigInteger;
140
  DecimalPoint: Integer;
141
  Len: Integer;
142
begin
143
  if System.Math.IsNaN(F) then
144
    Exit('NaN')
145
  else if IsNegativeInfinity(F) then
146
    Exit('NegInfinity')
147
  else if IsPositiveInfinity(F) then
148
    Exit('Infinity');
149

150
  Mantissa := GetSignificand(F);
151
  if Mantissa = 0 then
152
    Exit('0');
153

154
  Exponent := GetExponent(F) - 52;
155
  Sign := System.Math.Sign(F) < 0;
156
  if IsDenormal(F) then
157
    Mantissa := Mantissa and (UInt64(-1) shr 12);
158

159
  while not Odd(Mantissa) do
160
  begin
161
    Mantissa := Mantissa shr 1;
162
    Inc(Exponent);
163
  end;
164

165
  BigInt := Mantissa;
166

167
  DecimalPoint := 0;
168
  if Exponent < 0 then
169
  begin
170
    // BigInt must be repeatedly divided by 2.
171
    // This isn't done directly: On each iteration, BigInt is multiplied by 5 and then the decimal point is moved one
172
    // position to the left, which is equivalent to dividing by 10. This is done in one fell swoop, using Pow().
173
    BigInt := BigInt * BigInteger.Pow(5, -Exponent);
174
    DecimalPoint := -Exponent;
175
  end
176
  else
177
    // BigInt must repeatedly be multipied by 2. This is done in one go, by shifting the BigInteger left.
178
    BigInt := BigInt shl Exponent;
179

180
  Result := BigInt.ToString;
181
  Len := Length(Result);
182

183
  // Now we insert zeroes and the decimal point into the plain big integer value to get a nice output.
184

185
  if DecimalPoint = 0 then
186
    Result := Result                                             // e.g. 123.0
187
  else if DecimalPoint >= Len then
188
    Result := '0.' + StringOfChar('0', DecimalPoint - Len) + Result     // e.g. 0.00123
189
  else
190
    Result := Copy(Result, 1, Len - DecimalPoint) + '.' + Copy(Result, Len - DecimalPoint + 1, Len); // e.g. 12.3
191

192
  if Sign then
193
    Result := '-' + Result;
194
end;
195

196
function ExactString(const F: Single): string;
197
var
198
  Mantissa: UInt32;
199
  Exponent: Integer;
200
  Sign: Boolean;
201
  BigInt: BigInteger;
202
  DecimalPoint: Integer;
203
  Len: Integer;
204
begin
205
  if System.Math.IsNan(F) then
206
    Exit('NaN')
207
  else if IsNegativeInfinity(F) then
208
    Exit('NegInfinity')
209
  else if IsPositiveInfinity(F) then
210
    Exit('Infinity');
211

212
  Mantissa := GetSignificand(F);
213
  if Mantissa = 0 then
214
    Exit('0');
215

216
  Exponent := GetExponent(F) - 23;
217
  Sign := System.Math.Sign(F) < 0;
218
  if IsDenormal(F) then
219
    Mantissa := Mantissa and $7FFFFF;
220

221
  while not Odd(Mantissa) do
222
  begin
223
    Mantissa := Mantissa shr 1;
224
    Inc(Exponent);
225
  end;
226

227
  BigInt := Mantissa;
228

229
  DecimalPoint := 0;
230
  if Exponent < 0 then
231
  begin
232
    // BigInt must be repeatedly divided by 2.
233
    // This isn't done directly: On each iteration, BigInt is multiplied by 5 and then the decimal point is moved one
234
    // position to the left, which is equivalent to dividing by 10. This is done in one fell swoop, using Pow().
235
    BigInt := BigInt * BigInteger.Pow(5, -Exponent);
236
    DecimalPoint := -Exponent;
237
  end
238
  else
239
    // BigInt must repeatedly be multipied by 2. This is done in one go, by shifting the BigInteger left.
240
    BigInt := BigInt shl Exponent;
241

242
  Result := BigInt.ToString;
243
  Len := Length(Result);
244

245
  // Now we insert zeroes and the decimal point into the plain big integer value to get a nice output.
246

247
  if DecimalPoint = 0 then
248
    Result := Result                                             // e.g. 123.0
249
  else if DecimalPoint >= Len then
250
    Result := '0.' + StringOfChar('0', DecimalPoint - Len) + Result       // e.g. 0.00123
251
  else
252
    Result := Copy(Result, 1, Len - DecimalPoint) + '.' + Copy(Result, Len - DecimalPoint + 1, Len); // e.g. 12.3
253

254
  if Sign then
255
    Result := '-' + Result;
256

257
end;
258

259
end.
260