MathgeomGLS

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

38
unit Velthuis.ExactFloatStrings;
39

40
interface
41

42
uses
43
  System.SysUtils;
44

45
function ExactString(const F: Extended): string; overload;
46
function ExactString(const F: Double): string; overload;
47
function ExactString(const F: Single): string; overload;
48

49
implementation
50

51
uses Velthuis.BigIntegers;
52

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

57
function ExactString(const F: Extended): string;
58
var
59
  Mantissa: UInt64;
60
  Exponent: Integer;
61
  Sign: Boolean;
62
  BigInt: BigInteger;
63
  DecimalPoint: Integer;
64
  Len: Integer;
65
begin
66
  if F.IsNaN then
67
    Exit('NaN')
68
  else if F.IsNegativeInfinity then
69
    Exit('NegInfinity')
70
  else if F.IsPositiveInfinity then
71
    Exit('Infinity');
72

73
  Mantissa := F.Mantissa;
74
  if Mantissa = 0 then
75
    Exit('0.0');
76

77
  Exponent := F.Exponent - 63;
78
  Sign := F.Sign;
79

80
  while not Odd(Mantissa) do
81
  begin
82
    Mantissa := Mantissa shr 1;
83
    Inc(Exponent);
84
  end;
85

86
  BigInt := Mantissa;
87

88
  DecimalPoint := 0;
89
  if Exponent < 0 then
90
  begin
91
    // BigInt must repeatedly be divided by 2.
92
    // This isn't done directly: On each iteration, BigInt is multiplied by 5 and then the decimal point is moved one
93
    // position to the left, which is equivalent to dividing by 10. This is done in one fell swoop, using Pow().
94
    BigInt := BigInt * BigInteger.Pow(5, -Exponent);
95
    DecimalPoint := -Exponent;
96
  end
97
  else
98
    // BigInt must repeatedly be multipied by 2. This is done in one go, by shifting the BigInteger left by Exponent.
99
    BigInt := BigInt shl Exponent;
100

101
  Result := BigInt.ToString;
102
  Len := Length(Result);
103

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

106
  if DecimalPoint = 0 then
107
    Result := Result + '.0'                                             // e.g. 123.0
108
  else if DecimalPoint >= Len then
109
    Result := '0.' + StringOfChar('0', DecimalPoint - Len) + Result       // e.g. 0.00123
110
  else
111
    Result := Copy(Result, 1, Len - DecimalPoint) + '.' + Copy(Result, Len - DecimalPoint + 1, Len); // e.g. 12.3
112

113
  if Sign then
114
    Result := '-' + Result;
115
end;
116

117
function ExactString(const F: Double): string;
118
var
119
  Mantissa: UInt64;
120
  Exponent: Integer;
121
  Sign: Boolean;
122
  BigInt: BigInteger;
123
  DecimalPoint: Integer;
124
  Len: Integer;
125
begin
126
  if F.IsNaN then
127
    Exit('NaN')
128
  else if F.IsNegativeInfinity then
129
    Exit('NegInfinity')
130
  else if F.IsPositiveInfinity then
131
    Exit('Infinity');
132

133
  Mantissa := F.Mantissa;
134
  if Mantissa = 0 then
135
    Exit('0.0');
136

137
  Exponent := F.Exponent - 52;
138
  Sign := F.Sign;
139
  if F.SpecialType in [fsDenormal, fsNDenormal] then
140
    Mantissa := Mantissa and (UInt64(-1) shr 12);
141

142
  while not Odd(Mantissa) do
143
  begin
144
    Mantissa := Mantissa shr 1;
145
    Inc(Exponent);
146
  end;
147

148
  BigInt := Mantissa;
149

150
  DecimalPoint := 0;
151
  if Exponent < 0 then
152
  begin
153
    // BigInt must be repeatedly divided by 2.
154
    // This isn't done directly: On each iteration, BigInt is multiplied by 5 and then the decimal point is moved one
155
    // position to the left, which is equivalent to dividing by 10. This is done in one fell swoop, using Pow().
156
    BigInt := BigInt * BigInteger.Pow(5, -Exponent);
157
    DecimalPoint := -Exponent;
158
  end
159
  else
160
    // BigInt must repeatedly be multipied by 2. This is done in one go, by shifting the BigInteger left.
161
    BigInt := BigInt shl Exponent;
162

163
  Result := BigInt.ToString;
164
  Len := Length(Result);
165

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

168
  if DecimalPoint = 0 then
169
    Result := Result + '.0'                                             // e.g. 123.0
170
  else if DecimalPoint >= Len then
171
    Result := '0.' + StringOfChar('0', DecimalPoint - Len) + Result       // e.g. 0.00123
172
  else
173
    Result := Copy(Result, 1, Len - DecimalPoint) + '.' + Copy(Result, Len - DecimalPoint + 1, Len); // e.g. 12.3
174

175
  if Sign then
176
    Result := '-' + Result;
177
end;
178

179
function ExactString(const F: Single): string;
180
var
181
  Mantissa: UInt32;
182
  Exponent: Integer;
183
  Sign: Boolean;
184
  BigInt: BigInteger;
185
  DecimalPoint: Integer;
186
  Len: Integer;
187
begin
188
  if F.IsNaN then
189
    Exit('NaN')
190
  else if F.IsNegativeInfinity then
191
    Exit('NegInfinity')
192
  else if F.IsPositiveInfinity then
193
    Exit('Infinity');
194

195
  Mantissa := F.Mantissa;
196
  if Mantissa = 0 then
197
    Exit('0.0');
198

199
  Exponent := F.Exponent - 23;
200
  Sign := F.Sign;
201
  if F.SpecialType in [fsDenormal, fsNDenormal] then
202
    Mantissa := Mantissa and $7FFFFF;
203

204
  while not Odd(Mantissa) do
205
  begin
206
    Mantissa := Mantissa shr 1;
207
    Inc(Exponent);
208
  end;
209

210
  BigInt := Mantissa;
211

212
  DecimalPoint := 0;
213
  if Exponent < 0 then
214
  begin
215
    // BigInt must be repeatedly divided by 2.
216
    // This isn't done directly: On each iteration, BigInt is multiplied by 5 and then the decimal point is moved one
217
    // position to the left, which is equivalent to dividing by 10. This is done in one fell swoop, using Pow().
218
    BigInt := BigInt * BigInteger.Pow(5, -Exponent);
219
    DecimalPoint := -Exponent;
220
  end
221
  else
222
    // BigInt must repeatedly be multipied by 2. This is done in one go, by shifting the BigInteger left.
223
    BigInt := BigInt shl Exponent;
224

225
  Result := BigInt.ToString;
226
  Len := Length(Result);
227

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

230
  if DecimalPoint = 0 then
231
    Result := Result + '.0'                                             // e.g. 123.0
232
  else if DecimalPoint >= Len then
233
    Result := '0.' + StringOfChar('0', DecimalPoint - Len) + Result       // e.g. 0.00123
234
  else
235
    Result := Copy(Result, 1, Len - DecimalPoint) + '.' + Copy(Result, Len - DecimalPoint + 1, Len); // e.g. 12.3
236

237
  if Sign then
238
    Result := '-' + Result;
239

240
end;
241

242
end.
243