File Coverage

blib/lib/Data/Float.pm
Criterion Covered Total %
statement 230 266 86.4
branch 140 180 77.7
condition 33 39 84.6
subroutine 35 36 97.2
pod 21 21 100.0
total 459 542 84.6


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Data::Float - details of the floating point data type
4              
5             =head1 SYNOPSIS
6              
7             use Data::Float qw(have_signed_zero);
8              
9             if(have_signed_zero) { ...
10              
11             # and many other constants; see text
12              
13             use Data::Float qw(
14             float_class float_is_normal float_is_subnormal
15             float_is_nzfinite float_is_zero float_is_finite
16             float_is_infinite float_is_nan);
17              
18             $class = float_class($value);
19              
20             if(float_is_normal($value)) { ...
21             if(float_is_subnormal($value)) { ...
22             if(float_is_nzfinite($value)) { ...
23             if(float_is_zero($value)) { ...
24             if(float_is_finite($value)) { ...
25             if(float_is_infinite($value)) { ...
26             if(float_is_nan($value)) { ...
27              
28             use Data::Float qw(float_sign signbit float_parts);
29              
30             $sign = float_sign($value);
31             $sign_bit = signbit($value);
32             ($sign, $exponent, $significand) = float_parts($value);
33              
34             use Data::Float qw(float_hex hex_float);
35              
36             print float_hex($value);
37             $value = hex_float($string);
38              
39             use Data::Float qw(float_id_cmp totalorder);
40              
41             @sorted_floats = sort { float_id_cmp($a, $b) } @floats;
42             if(totalorder($a, $b)) { ...
43              
44             use Data::Float qw(
45             pow2 mult_pow2 copysign nextup nextdown nextafter);
46              
47             $x = pow2($exp);
48             $x = mult_pow2($value, $exp);
49             $x = copysign($magnitude, $sign_from);
50             $x = nextup($x);
51             $x = nextdown($x);
52             $x = nextafter($x, $direction);
53              
54             =head1 DESCRIPTION
55              
56             This module is about the native floating point numerical data type.
57             A floating point number is one of the types of datum that can appear
58             in the numeric part of a Perl scalar. This module supplies constants
59             describing the native floating point type, classification functions,
60             and functions to manipulate floating point values at a low level.
61              
62             =head1 FLOATING POINT
63              
64             =head2 Classification
65              
66             Floating point values are divided into five subtypes:
67              
68             =over
69              
70             =item normalised
71              
72             The value is made up of a sign bit (making the value positive or
73             negative), a significand, and exponent. The significand is a number
74             in the range [1, 2), expressed as a binary fraction of a certain fixed
75             length. (Significands requiring a longer binary fraction, or lacking a
76             terminating binary representation, cannot be obtained.) The exponent
77             is an integer in a certain fixed range. The magnitude of the value
78             represented is the product of the significand and two to the power of
79             the exponent.
80              
81             =item subnormal
82              
83             The value is made up of a sign bit, significand, and exponent, as
84             for normalised values. However, the exponent is fixed at the minimum
85             possible for a normalised value, and the significand is in the range
86             (0, 1). The length of the significand is the same as for normalised
87             values. This is essentially a fixed-point format, used to provide
88             gradual underflow. Not all floating point formats support this subtype.
89             Where it is not supported, underflow is sudden, and the difference between
90             two minimum-exponent normalised values cannot be exactly represented.
91              
92             =item zero
93              
94             Depending on the floating point type, there may be either one or two
95             zero values: zeroes may carry a sign bit. Where zeroes are signed,
96             it is primarily in order to indicate the direction from which a value
97             underflowed (was rounded) to zero. Positive and negative zero compare
98             as numerically equal, and they give identical results in most arithmetic
99             operations. They are on opposite sides of some branch cuts in complex
100             arithmetic.
101              
102             =item infinite
103              
104             Some floating point formats include special infinite values. These are
105             generated by overflow, and by some arithmetic cases that mathematically
106             generate infinities. There are two infinite values: positive infinity
107             and negative infinity.
108              
109             Perl does not always generate infinite values when normal floating point
110             behaviour calls for it. For example, the division C<1.0/0.0> causes an
111             exception rather than returning an infinity.
112              
113             =item not-a-number (NaN)
114              
115             This type of value exists in some floating point formats to indicate
116             error conditions. Mathematically undefined operations may generate NaNs,
117             and NaNs propagate through all arithmetic operations. A NaN has the
118             distinctive property of comparing numerically unequal to all floating
119             point values, including itself.
120              
121             Perl does not always generate NaNs when normal floating point behaviour
122             calls for it. For example, the division C<0.0/0.0> causes an exception
123             rather than returning a NaN.
124              
125             Perl has only (at most) one NaN value, even if the underlying system
126             supports different NaNs. (IEEE 754 arithmetic has NaNs which carry a
127             quiet/signal bit, a sign bit (yes, a sign on a not-number), and many
128             bits of implementation-defined data.)
129              
130             =back
131              
132             =head2 Mixing floating point and integer values
133              
134             Perl does not draw a strong type distinction between native integer
135             (see L) and native floating point values. Both types
136             of value can be stored in the numeric part of a plain (string) scalar.
137             No distinction is made between the integer representation and the floating
138             point representation where they encode identical values. Thus, for
139             floating point arithmetic, native integer values that can be represented
140             exactly in floating point may be freely used as floating point values.
141              
142             Native integer arithmetic has exactly one zero value, which has no sign.
143             If the floating point type does not have signed zeroes then the floating
144             point and integer zeroes are exactly equivalent. If the floating point
145             type does have signed zeroes then the integer zero can still be used in
146             floating point arithmetic, and it behaves as an unsigned floating point
147             zero. On such systems there are therefore three types of zero available.
148             There is a bug in Perl which sometimes causes floating point zeroes to
149             change into integer zeroes; see L for details.
150              
151             Where a native integer value is used that is too large to exactly
152             represent in floating point, it will be rounded as necessary to a
153             floating point value. This rounding will occur whenever an operation
154             has to be performed in floating point because the result could not be
155             exactly represented as an integer. This may be confusing to functions
156             that expect a floating point argument.
157              
158             Similarly, some operations on floating point numbers will actually be
159             performed in integer arithmetic, and may result in values that cannot
160             be exactly represented in floating point. This happens whenever the
161             arguments have integer values that fit into the native integer type and
162             the mathematical result can be exactly represented as a native integer.
163             This may be confusing in cases where floating point semantics are
164             expected.
165              
166             See L for discussion of Perl's numeric semantics.
167              
168             =cut
169              
170             package Data::Float;
171              
172 9     9   1425301 { use 5.006; }
  9         43  
173 9     9   59 use warnings;
  9         44  
  9         625  
174 9     9   71 use strict;
  9         51  
  9         408  
175              
176 9     9   49 use Carp qw(croak);
  9         34  
  9         895  
177              
178             our $VERSION = "0.015";
179              
180 9     9   3966 use parent "Exporter";
  9         2737  
  9         63  
181             our @EXPORT_OK = qw(
182             float_class float_is_normal float_is_subnormal float_is_nzfinite
183             float_is_zero float_is_finite float_is_infinite float_is_nan
184             float_sign signbit float_parts
185             float_hex hex_float
186             float_id_cmp totalorder
187             pow2 mult_pow2 copysign nextup nextdown nextafter
188             );
189             # constant functions get added to @EXPORT_OK later
190              
191             =head1 CONSTANTS
192              
193             =head2 Features
194              
195             =over
196              
197             =item have_signed_zero
198              
199             Truth value indicating whether floating point zeroes carry a sign. If yes,
200             then there are two floating point zero values: +0.0 and -0.0. (Perl
201             scalars can nevertheless also hold an integer zero, which is unsigned.)
202             If no, then there is only one zero value, which is unsigned.
203              
204             =item have_subnormal
205              
206             Truth value indicating whether there are subnormal floating point values.
207              
208             =item have_infinite
209              
210             Truth value indicating whether there are infinite floating point values.
211              
212             =item have_nan
213              
214             Truth value indicating whether there are NaN floating point values.
215              
216             It is difficult to reliably generate a NaN in Perl, so in some unlikely
217             circumstances it is possible that there might be NaNs that this module
218             failed to detect. In that case this constant would be false but a NaN
219             might still turn up somewhere. What this constant reliably indicates
220             is the availability of the C constant below.
221              
222             =back
223              
224             =head2 Extrema
225              
226             =over
227              
228             =item significand_bits
229              
230             The number of fractional bits in the significand of finite floating
231             point values. The significand also has an implicit integer bit, not
232             counted in this constant; the integer bit is always 1 for normalised
233             values and always 0 for subnormal values.
234              
235             =item significand_step
236              
237             The difference between adjacent representable values in the range [1, 2]
238             (where the exponent is zero). This is equal to 2^-significand_bits.
239              
240             =item max_finite_exp
241              
242             The maximum exponent permitted for finite floating point values.
243              
244             =item max_finite_pow2
245              
246             The maximum representable power of two. This is 2^max_finite_exp.
247              
248             =item max_finite
249              
250             The maximum representable finite value. This is 2^(max_finite_exp+1)
251             - 2^(max_finite_exp-significand_bits).
252              
253             =item max_number
254              
255             The maximum representable number. This is positive infinity if there
256             are infinite values, or max_finite if there are not.
257              
258             =item max_integer
259              
260             The maximum integral value for which all integers from zero to that
261             value inclusive are representable. Equivalently: the minimum positive
262             integral value N for which the value N+1 is not representable. This is
263             2^(significand_bits+1). The name is somewhat misleading.
264              
265             =item min_normal_exp
266              
267             The minimum exponent permitted for normalised floating point values.
268              
269             =item min_normal
270              
271             The minimum positive value representable as a normalised floating
272             point value. This is 2^min_normal_exp.
273              
274             =item min_finite_exp
275              
276             The base two logarithm of the minimum representable positive finite value.
277             If there are subnormals then this is min_normal_exp - significand_bits.
278             If there are no subnormals then this is min_normal_exp.
279              
280             =item min_finite
281              
282             The minimum representable positive finite value. This is
283             2^min_finite_exp.
284              
285             =back
286              
287             =head2 Special Values
288              
289             =over
290              
291             =item pos_zero
292              
293             The positive zero value. (Exists only if zeroes are signed, as indicated
294             by the C constant.)
295              
296             If Perl is at risk of transforming floating point zeroes into integer
297             zeroes (see L), then this is actually a non-constant function
298             that always returns a fresh floating point zero. Thus the return value
299             is always a true floating point zero, regardless of what happened to
300             zeroes previously returned.
301              
302             =item neg_zero
303              
304             The negative zero value. (Exists only if zeroes are signed, as indicated
305             by the C constant.)
306              
307             If Perl is at risk of transforming floating point zeroes into integer
308             zeroes (see L), then this is actually a non-constant function
309             that always returns a fresh floating point zero. Thus the return value
310             is always a true floating point zero, regardless of what happened to
311             zeroes previously returned.
312              
313             =item pos_infinity
314              
315             The positive infinite value. (Exists only if there are infinite values,
316             as indicated by the C constant.)
317              
318             =item neg_infinity
319              
320             The negative infinite value. (Exists only if there are infinite values,
321             as indicated by the C constant.)
322              
323             =item nan
324              
325             Not-a-number. (Exists only if NaN values were detected, as indicated
326             by the C constant.)
327              
328             =back
329              
330             =cut
331              
332             sub _mk_constant($$) {
333 180     180   360 my($name, $value) = @_;
334 9     9   2251 no strict "refs";
  9         19  
  9         11051  
335 180     0   1130 *{__PACKAGE__."::".$name} = sub () { $value };
  180         779  
  0         0  
336 180         424 push @EXPORT_OK, $name;
337             }
338              
339             #
340             # mult_pow2() multiplies a specified value by a specified power of two.
341             # This is done using repeated multiplication, and can cope with cases
342             # where the power of two cannot be directly represented as a floating
343             # point value. (E.g., 0x1.b2p-900 can be multiplied by 2^1500 to get
344             # to 0x1.b2p+600; the input and output values can be represented in
345             # IEEE double, but 2^1500 cannot.) Overflow and underflow can occur.
346             #
347             # @powtwo is an array such that powtwo[i] = 2^2^i. Its elements are
348             # used in the repeated multiplication in mult_pow2. Similarly,
349             # @powhalf is such that powhalf[i] = 2^-2^i. Reading the exponent
350             # in binary indicates which elements of @powtwo/@powhalf to multiply
351             # by, except that it may indicate elements that don't exist, either
352             # because they're not representable or because the arrays haven't
353             # been filled yet. mult_pow2() will use the last element of the array
354             # repeatedly in this case. Thus array elements after the first are
355             # only an optimisation, and do not change behaviour.
356             #
357              
358             my @powtwo = (2.0);
359             my @powhalf = (0.5);
360              
361             sub mult_pow2($$) {
362 711     711 1 12472 my($value, $exp) = @_;
363 711 100       1859 return $_[0] if $value == 0.0;
364 632         917 my $powa = \@powtwo;
365 632 100       1310 if($exp < 0) {
366 368         564 $powa = \@powhalf;
367 368         560 $exp = -$exp;
368             }
369 632   100     2134 for(my $i = 0; $i != $#$powa && $exp != 0; $i++) {
370 3125 100       6922 $value *= $powa->[$i] if $exp & 1;
371 3125         10574 $exp >>= 1;
372             }
373 632         1434 $value *= $powa->[-1] while $exp--;
374 632         4801 return $value;
375             }
376              
377             #
378             # Range of finite exponent values.
379             #
380              
381             my $min_finite_exp;
382             my $max_finite_exp;
383             my $max_finite_pow2;
384             my $min_finite;
385              
386             my @directions = (
387             {
388             expsign => -1,
389             powa => \@powhalf,
390             xexp => \$min_finite_exp,
391             xpower => \$min_finite,
392             },
393             {
394             expsign => +1,
395             powa => \@powtwo,
396             xexp => \$max_finite_exp,
397             xpower => \$max_finite_pow2,
398             },
399             );
400              
401             while(!$directions[0]->{done} || !$directions[1]->{done}) {
402             foreach my $direction (@directions) {
403             next if $direction->{done};
404             my $lastpow = $direction->{powa}->[-1];
405             my $nextpow = $lastpow * $lastpow;
406             unless(mult_pow2($nextpow, -$direction->{expsign} *
407             (1 << (@{$direction->{powa}} - 1)))
408             == $lastpow) {
409             $direction->{done} = 1;
410             next;
411             }
412             push @{$direction->{powa}}, $nextpow;
413             }
414             }
415              
416             foreach my $direction (@directions) {
417             my $expsign = $direction->{expsign};
418             my $xexp = 1 << (@{$direction->{powa}} - 1);
419             my $extremum = $direction->{powa}->[-1];
420             for(my $addexp = $xexp; $addexp >>= 1; ) {
421             my $nx = mult_pow2($extremum, $expsign*$addexp);
422             if(mult_pow2($nx, -$expsign*$addexp) == $extremum) {
423             $xexp += $addexp;
424             $extremum = $nx;
425             }
426             }
427             ${$direction->{xexp}} = $expsign * $xexp;
428             ${$direction->{xpower}} = $extremum;
429             }
430              
431             _mk_constant("min_finite_exp", $min_finite_exp);
432             _mk_constant("min_finite", $min_finite);
433             _mk_constant("max_finite_exp", $max_finite_exp);
434             _mk_constant("max_finite_pow2", $max_finite_pow2);
435              
436             #
437             # pow2() generates a power of two from scratch. It complains if given
438             # an exponent that would make an unrepresentable value.
439             #
440              
441             sub pow2($) {
442 39     39 1 237462 my($exp) = @_;
443 39 100 100     1521 croak "exponent $exp out of range [$min_finite_exp, $max_finite_exp]"
444             unless $exp >= $min_finite_exp && $exp <= $max_finite_exp;
445 37         902 return mult_pow2(1.0, $exp);
446             }
447              
448             #
449             # Significand size.
450             #
451              
452             my($significand_bits, $significand_step);
453             {
454             my $i;
455             for($i = 1; ; $i++) {
456             my $tryeps = $powhalf[$i];
457             last unless (1.0 + $tryeps) - 1.0 == $tryeps;
458             }
459             $i--;
460             $significand_bits = 1 << $i;
461             $significand_step = $powhalf[$i];
462             while($i--) {
463             my $tryeps = $significand_step * $powhalf[$i];
464             if((1.0 + $tryeps) - 1.0 == $tryeps) {
465             $significand_bits += 1 << $i;
466             $significand_step = $tryeps;
467             }
468             }
469             }
470              
471             _mk_constant("significand_bits", $significand_bits);
472             _mk_constant("significand_step", $significand_step);
473              
474             my $max_finite = $max_finite_pow2 -
475             pow2($max_finite_exp - $significand_bits - 1);
476             $max_finite += $max_finite;
477              
478             my $max_integer = pow2($significand_bits + 1);
479              
480             _mk_constant("max_finite", $max_finite);
481             _mk_constant("max_integer", $max_integer);
482              
483             #
484             # Subnormals.
485             #
486              
487             my $have_subnormal;
488             {
489             my $testval = $min_finite * 1.5;
490             $have_subnormal = $testval == $min_finite ||
491             $testval == ($min_finite + $min_finite);
492             }
493              
494             _mk_constant("have_subnormal", $have_subnormal);
495              
496             my $min_normal_exp = $have_subnormal ?
497             $min_finite_exp + $significand_bits :
498             $min_finite_exp;
499             my $min_normal = $have_subnormal ?
500             mult_pow2($min_finite, $significand_bits) :
501             $min_finite;
502              
503             _mk_constant("min_normal_exp", $min_normal_exp);
504             _mk_constant("min_normal", $min_normal);
505              
506             #
507             # Feature tests.
508             #
509              
510             my $have_signed_zero = sprintf("%e", -0.0) =~ /\A-/;
511             _mk_constant("have_signed_zero", $have_signed_zero);
512             my($pos_zero, $neg_zero);
513             if($have_signed_zero) {
514             $pos_zero = +0.0;
515             $neg_zero = -0.0;
516             my $tzero = -0.0;
517 9     9   71 { no warnings "void"; $tzero == $tzero; }
  9         19  
  9         5762  
518             my $ntzero = -$tzero;
519             if(sprintf("%e", -$ntzero) =~ /\A-/) {
520             _mk_constant("pos_zero", $pos_zero);
521             _mk_constant("neg_zero", $neg_zero);
522             } else {
523             # Zeroes lose their signedness upon arithmetic operations.
524             # Therefore make the pos_zero and neg_zero functions
525             # return fresh zeroes to avoid trouble.
526             *pos_zero = sub () { my $ret = $pos_zero };
527             *neg_zero = sub () { my $ret = $neg_zero };
528             push @EXPORT_OK, "pos_zero", "neg_zero";
529             }
530             }
531              
532             my($have_infinite, $pos_infinity, $neg_infinity);
533             {
534             my $testval = $max_finite * $max_finite;
535             $have_infinite = $testval == $testval && $testval != $max_finite;
536             _mk_constant("have_infinite", $have_infinite);
537             if($have_infinite) {
538             _mk_constant("pos_infinity", $pos_infinity = $testval);
539             _mk_constant("neg_infinity", $neg_infinity = -$testval);
540             }
541             }
542              
543             my $max_number = $have_infinite ? $pos_infinity : $max_finite;
544             _mk_constant("max_number", $max_number);
545              
546             my($have_nan, $nan);
547             foreach my $nan_formula (
548             '$have_infinite && $pos_infinity/$pos_infinity',
549             'log(-1.0)',
550             '0.0/0.0',
551             '"nan"') {
552             my $maybe_nan =
553             eval 'local $SIG{__DIE__}; local $SIG{__WARN__} = sub { }; '.
554             $nan_formula;
555             if(do { local $SIG{__WARN__} = sub { }; $maybe_nan != $maybe_nan }) {
556             $have_nan = 1;
557             $nan = $maybe_nan;
558             _mk_constant("nan", $nan);
559             last;
560             }
561             }
562             _mk_constant("have_nan", $have_nan);
563              
564             # The rest of the code is parsed after the constants have been calculated
565             # and installed, so that it can benefit from their constancy.
566             {
567             local $/ = undef;
568             my $code = ;
569             close(DATA);
570             {
571             local $SIG{__DIE__};
572 9 50 66 9 1 79 eval $code;
  9 100 100 9 1 21  
  9 100 100 9 1 17  
  9 100 100 9 1 21  
  9 100 66 9 1 14  
  9 100 100 268 1 52  
  9 100 100 39 1 19  
  9 100 0 42 1 1220  
  9 100 100 41 1 62  
  9 100 100 162 1 16  
  9 100 66 14 1 750  
  9 100   96 1 5212  
  9 100   402 1 411  
  9 100   14 1 55  
  9 100   76 1 712  
  9 100   14 1 20  
  9 50   174 1 15  
  9 100   62 1 17297  
  9 0   28 1 101  
  9 0   54   175  
  9 50   22   59  
  268 50   17   423  
  268 100   33   516  
  268 100   140   861  
  39 0   81   254637  
  39 50       113  
  37 50       93  
  37 50       318  
  42 50       284310  
  42 100       128  
  24 50       56  
  21 100       41  
  21 100       49  
  15 100       64  
  41 100       262151  
  41 50       240  
  39 100       63  
  39 50       59  
  39 100       256  
  2 100       7  
  4 100       11  
  2 100       34  
  2 100       7  
  35 100       61  
  35 50       65  
  6 100       19  
  6 100       49  
  6 100       39  
  4 100       12  
  4 100       13  
  1 100       3  
  1 50       4  
  0 100       0  
  2 100       5  
  29 100       67  
  31 100       64  
  31 100       89  
  0 100       0  
  0 0       0  
  0 50       0  
  0 50       0  
  0 50       0  
  0 50       0  
  0 0       0  
  31 0       55  
  31 0       76  
  62 0       112  
  62 0       75  
  62 0       202  
  62 50       118  
  31 100       158  
  31 100       67  
  31 100       64  
  31 100       41  
  31 50       43  
  31 100       101  
  62 100       104  
  62 100       90  
  62 100       152  
  32 100       67  
  62 50       160  
  0 100       0  
  62 100       196  
  31 100       72  
  31 100       62  
  31 100       72  
  11         25  
  4         9  
  4         24  
  2         4  
  2         3  
  2         5  
  2         3  
  2         5  
  2         6  
  1         1  
  1         2  
  31         51  
  31         51  
  31         79  
  2         7  
  0         0  
  31         222  
  31         76  
  162         214106  
  162         249  
  18         24  
  16         46  
  8         20  
  120         444  
  14         4264  
  14         52  
  96         5654  
  96         140  
  96         587  
  402         2884  
  402         1011  
  14         2757  
  76         3658  
  76         509  
  14         3186  
  174         2291  
  174         441  
  62         9057  
  62         207  
  62         124  
  62         252  
  19         37  
  19         33  
  62         148  
  5         20  
  57         89  
  57         139  
  7         28  
  77         100  
  77         174  
  10         18  
  10         32  
  7         16  
  7         14  
  27         105  
  270         366  
  270         611  
  70         113  
  70         229  
  57         190  
  28         163326  
  28         68  
  28         54  
  54         6347  
  54         550  
  18         111  
  18         29  
  18         52  
  18         40  
  18         35  
  18         53  
  18         53  
  6         12  
  6         31  
  12         30  
  12         26  
  12         49  
  12         75  
  12         39  
  12         30  
  12         22  
  12         36  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  12         21  
  12         19  
  12         30  
  12         43  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  12         23  
  12         77  
  15         104  
  12         38  
  18         146  
  18         29  
  18         169  
  18         30  
  18         73  
  0         0  
  22         14454  
  22         268  
  15         61  
  17         1381  
  33         237056  
  33         194  
  28         80  
  24         90  
  16         42  
  16         49  
  8         13  
  8         23  
  4         34  
  0         0  
  0         0  
  8         29  
  2         3  
  2         41  
  8         17  
  12         41  
  140         240  
  140         759  
  81         222  
573             }
574             die $@ if $@ ne "";
575             }
576              
577             1;
578              
579             __DATA__