File Coverage

blib/lib/Data/Float.pm
Criterion Covered Total %
statement 233 269 86.6
branch 140 180 77.7
condition 33 39 84.6
subroutine 37 38 97.3
pod 21 21 100.0
total 464 547 84.8


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