File Coverage

blib/lib/Test/Number/Delta.pm
Criterion Covered Total %
statement 93 93 100.0
branch 42 42 100.0
condition 12 18 66.6
subroutine 16 16 100.0
pod 4 4 100.0
total 167 173 96.5


line stmt bran cond sub pod time code
1 11     11   86358 use strict;
  11         18  
  11         402  
2 11     11   52 use warnings;
  11         16  
  11         582  
3              
4             package Test::Number::Delta;
5             # ABSTRACT: Compare the difference between numbers against a given tolerance
6              
7             our $VERSION = '1.05';
8              
9 11     11   53 use vars qw (@EXPORT @ISA);
  11         17  
  11         622  
10              
11             # Required modules
12 11     11   49 use Carp;
  11         13  
  11         652  
13 11     11   2390 use Test::Builder;
  11         31337  
  11         221  
14 11     11   43 use Exporter;
  11         14  
  11         11992  
15              
16             @ISA = qw( Exporter );
17             @EXPORT = qw( delta_not_ok delta_ok delta_within delta_not_within );
18              
19             #pod =head1 SYNOPSIS
20             #pod
21             #pod # Import test functions
22             #pod use Test::Number::Delta;
23             #pod
24             #pod # Equality test with default tolerance
25             #pod delta_ok( 1e-5, 2e-5, 'values within 1e-6');
26             #pod
27             #pod # Inequality test with default tolerance
28             #pod delta_not_ok( 1e-5, 2e-5, 'values not within 1e-6');
29             #pod
30             #pod # Provide specific tolerance
31             #pod delta_within( 1e-3, 2e-3, 1e-4, 'values within 1e-4');
32             #pod delta_not_within( 1e-3, 2e-3, 1e-4, 'values not within 1e-4');
33             #pod
34             #pod # Compare arrays or matrices
35             #pod @a = ( 3.14, 1.41 );
36             #pod @b = ( 3.15, 1.41 );
37             #pod delta_ok( \@a, \@b, 'compare @a and @b' );
38             #pod
39             #pod # Set a different default tolerance
40             #pod use Test::Number::Delta within => 1e-5;
41             #pod delta_ok( 1.1e-5, 2e-5, 'values within 1e-5'); # ok
42             #pod
43             #pod # Set a relative tolerance
44             #pod use Test::Number::Delta relative => 1e-3;
45             #pod delta_ok( 1.01, 1.0099, 'values within 1.01e-3');
46             #pod
47             #pod
48             #pod =head1 DESCRIPTION
49             #pod
50             #pod At some point or another, most programmers find they need to compare
51             #pod floating-point numbers for equality. The typical idiom is to test
52             #pod if the absolute value of the difference of the numbers is within a desired
53             #pod tolerance, usually called epsilon. This module provides such a function for use
54             #pod with L. Usage is similar to other test functions described in
55             #pod L. Semantically, the C function replaces this kind
56             #pod of construct:
57             #pod
58             #pod ok ( abs($p - $q) < $epsilon, '$p is equal to $q' ) or
59             #pod diag "$p is not equal to $q to within $epsilon";
60             #pod
61             #pod While there's nothing wrong with that construct, it's painful to type it
62             #pod repeatedly in a test script. This module does the same thing with a single
63             #pod function call. The C function is similar, but either uses a global
64             #pod default value for epsilon or else calculates a 'relative' epsilon on
65             #pod the fly so that epsilon is scaled automatically to the size of the arguments to
66             #pod C. Both functions are exported automatically.
67             #pod
68             #pod Because checking floating-point equality is not always reliable, it is not
69             #pod possible to check the 'equal to' boundary of 'less than or equal to
70             #pod epsilon'. Therefore, Test::Number::Delta only compares if the absolute value
71             #pod of the difference is B epsilon (for equality tests) or
72             #pod B epsilon (for inequality tests).
73             #pod
74             #pod =head1 USAGE
75             #pod
76             #pod =head2 use Test::Number::Delta;
77             #pod
78             #pod With no arguments, epsilon defaults to 1e-6. (An arbitrary choice on the
79             #pod author's part.)
80             #pod
81             #pod =head2 use Test::Number::Delta within => 1e-9;
82             #pod
83             #pod To specify a different default value for epsilon, provide a C parameter
84             #pod when importing the module. The value must be non-zero.
85             #pod
86             #pod =head2 use Test::Number::Delta relative => 1e-3;
87             #pod
88             #pod As an alternative to using a fixed value for epsilon, provide a C
89             #pod parameter when importing the module. This signals that C should
90             #pod test equality with an epsilon that is scaled to the size of the arguments.
91             #pod Epsilon is calculated as the relative value times the absolute value
92             #pod of the argument with the greatest magnitude. Mathematically, for arguments
93             #pod 'x' and 'y':
94             #pod
95             #pod epsilon = relative * max( abs(x), abs(y) )
96             #pod
97             #pod For example, a relative value of "0.01" would mean that the arguments are equal
98             #pod if they differ by less than 1% of the larger of the two values. A relative
99             #pod value of 1e-6 means that the arguments must differ by less than 1 millionth
100             #pod of the larger value. The relative value must be non-zero.
101             #pod
102             #pod =head2 Combining with a test plan
103             #pod
104             #pod use Test::Number::Delta 'no_plan';
105             #pod
106             #pod # or
107             #pod
108             #pod use Test::Number::Delta within => 1e-9, tests => 1;
109             #pod
110             #pod If a test plan has not already been specified, the optional
111             #pod parameter for Test::Number::Delta may be followed with a test plan (see
112             #pod L for details). If a parameter for Test::Number::Delta is
113             #pod given, it must come first.
114             #pod
115             #pod =cut
116              
117             my $Test = Test::Builder->new;
118             my $Epsilon = 1e-6;
119             my $Relative = undef;
120              
121             sub import {
122 13     13   1649 my $self = shift;
123 13         23 my $pack = caller;
124 13         220 my $found = grep /within|relative/, @_;
125 13 100       276 croak "Can't specify more than one of 'within' or 'relative'"
126             if $found > 1;
127 12 100       27 if ($found) {
128 8         24 my ( $param, $value ) = splice @_, 0, 2;
129 8 100       210 croak "'$param' parameter must be non-zero"
130             if $value == 0;
131 6 100       21 if ( $param eq 'within' ) {
    100          
132 3         5 $Epsilon = abs($value);
133             }
134             elsif ( $param eq 'relative' ) {
135 2         4 $Relative = abs($value);
136             }
137             else {
138 1         219 croak "Test::Number::Delta parameters must come first";
139             }
140             }
141 9         37 $Test->exported_to($pack);
142 9         63 $Test->plan(@_);
143 9         13872 $self->export_to_level( 1, $self, $_ ) for @EXPORT;
144             }
145              
146             #--------------------------------------------------------------------------#
147             # _check -- recursive function to perform comparison
148             #--------------------------------------------------------------------------#
149              
150             sub _check {
151 110     110   149 my ( $p, $q, $e, $name, @indices ) = @_;
152 110         95 my $epsilon;
153              
154 110 100       168 if ( !defined $e ) {
155 79 100       195 $epsilon =
    100          
156             $Relative
157             ? $Relative * ( abs($p) > abs($q) ? abs($p) : abs($q) )
158             : $Epsilon;
159             }
160             else {
161 31         29 $epsilon = abs($e);
162             }
163              
164 110         112 my ( $ok, $diag ) = ( 1, q{} ); # assume true
165 110 100 66     408 if ( ref $p eq 'ARRAY' || ref $q eq 'ARRAY' ) {
166 30 100       40 if ( @$p == @$q ) {
167 29         24 for my $i ( 0 .. $#{$p} ) {
  29         59  
168 52         42 my @new_indices;
169 52 100       544 ( $ok, $diag, @new_indices ) =
170             _check( $p->[$i], $q->[$i], $e, $name, scalar @indices ? @indices : (), $i, );
171 52 100       115 if ( not $ok ) {
172 11         13 @indices = @new_indices;
173 11         16 last;
174             }
175             }
176             }
177             else {
178 1         2 $ok = 0;
179 1         4 $diag =
180             "Got an array of length "
181             . scalar(@$p)
182             . ", but expected an array of length "
183             . scalar(@$q);
184             }
185             }
186             else {
187 80         134 $ok = abs( $p - $q ) < $epsilon;
188 80 100       140 if ( !$ok ) {
189 27         50 my ( $ep, $dp ) = _ep_dp($epsilon);
190 27         336 $diag = sprintf( "%.${dp}f and %.${dp}f are not equal" . " to within %.${ep}f",
191             $p, $q, $epsilon );
192             }
193             }
194 110 100       352 return ( $ok, $diag, scalar(@indices) ? @indices : () );
195             }
196              
197             sub _ep_dp {
198 71 100   71   160 my $epsilon = shift
199             or return;
200 52         46 $epsilon = abs($epsilon);
201 52         576 my ($exp) = sprintf( "%e", $epsilon ) =~ m/e(.+)/;
202 52 100       140 my $ep = $exp < 0 ? -$exp : 1;
203 52         59 my $dp = $ep + 1;
204 52         91 return ( $ep, $dp );
205             }
206              
207             sub _diag_default {
208 19   66 19   515 my ($ep) = _ep_dp( abs( $Relative || $Epsilon ) );
209 19         29 my $diag = "Arguments are equal to within ";
210 19 100       115 $diag .=
211             $Relative
212             ? sprintf( "relative tolerance %.${ep}f", abs($Relative) )
213             : sprintf( "%.${ep}f", abs($Epsilon) );
214 19         35 return $diag;
215             }
216              
217             #pod =head1 FUNCTIONS
218             #pod
219             #pod =cut
220              
221             #--------------------------------------------------------------------------#
222             # delta_within()
223             #--------------------------------------------------------------------------#
224              
225             #pod =head2 delta_within
226             #pod
227             #pod delta_within( $p, $q, $epsilon, '$p and $q are equal within $epsilon' );
228             #pod delta_within( \@p, \@q, $epsilon, '@p and @q are equal within $epsilon' );
229             #pod
230             #pod This function tests for equality within a given value of epsilon. The test is
231             #pod true if the absolute value of the difference between $p and $q is B
232             #pod epsilon. If the test is true, it prints an "OK" statement for use in testing.
233             #pod If the test is not true, this function prints a failure report and diagnostic.
234             #pod Epsilon must be non-zero.
235             #pod
236             #pod The values to compare may be scalars or references to arrays. If the values
237             #pod are references to arrays, the comparison is done pairwise for each index value
238             #pod of the array. The pairwise comparison is recursive, so matrices may
239             #pod be compared as well.
240             #pod
241             #pod For example, this code sample compares two matrices:
242             #pod
243             #pod my @a = ( [ 3.14, 6.28 ],
244             #pod [ 1.41, 2.84 ] );
245             #pod
246             #pod my @b = ( [ 3.14, 6.28 ],
247             #pod [ 1.42, 2.84 ] );
248             #pod
249             #pod delta_within( \@a, \@b, 1e-6, 'compare @a and @b' );
250             #pod
251             #pod The sample prints the following:
252             #pod
253             #pod not ok 1 - compare @a and @b
254             #pod # At [1][0]: 1.4100000 and 1.4200000 are not equal to within 0.000001
255             #pod
256             #pod =cut
257              
258             sub delta_within($$$;$) { ## no critic
259 7     7 1 5828 my ( $p, $q, $epsilon, $name ) = @_;
260 7 100 66     147 croak "Value of epsilon to delta_within must be non-zero"
261             if !defined($epsilon) || $epsilon == 0;
262             {
263 6         8 local $Test::Builder::Level = $Test::Builder::Level + 1;
  6         8  
264 6         10 _delta_within( $p, $q, $epsilon, $name );
265             }
266             }
267              
268             sub _delta_within {
269 33     33   45 my ( $p, $q, $epsilon, $name ) = @_;
270 33         71 my ( $ok, $diag, @indices ) = _check( $p, $q, $epsilon, $name );
271 33 100       80 if (@indices) {
272 4         14 $diag = "At [" . join( "][", @indices ) . "]: $diag";
273             }
274 33   66     108 return $Test->ok( $ok, $name ) || $Test->diag($diag);
275             }
276              
277             #--------------------------------------------------------------------------#
278             # delta_ok()
279             #--------------------------------------------------------------------------#
280              
281             #pod =head2 delta_ok
282             #pod
283             #pod delta_ok( $p, $q, '$p and $q are close enough to equal' );
284             #pod delta_ok( \@p, \@q, '@p and @q are close enough to equal' );
285             #pod
286             #pod This function tests for equality within a default epsilon value. See L
287             #pod for details on changing the default. Otherwise, this function works the same
288             #pod as C.
289             #pod
290             #pod =cut
291              
292             sub delta_ok($$;$) { ## no critic
293 27     27 1 20203 my ( $p, $q, $name ) = @_;
294             {
295 27         41 local $Test::Builder::Level = $Test::Builder::Level + 1;
  27         50  
296 27         68 _delta_within( $p, $q, undef, $name );
297             }
298             }
299              
300             #--------------------------------------------------------------------------#
301             # delta_not_ok()
302             #--------------------------------------------------------------------------#
303              
304             #pod =head2 delta_not_within
305             #pod
306             #pod delta_not_within( $p, $q, '$p and $q are different' );
307             #pod delta_not_within( \@p, \@q, $epsilon, '@p and @q are different' );
308             #pod
309             #pod This test compares inequality in excess of a given value of epsilon. The test
310             #pod is true if the absolute value of the difference between $p and $q is B
311             #pod than> epsilon. For array or matrix comparisons, the test is true if I
312             #pod pair of values differs by more than epsilon. Otherwise, this function works
313             #pod the same as C.
314             #pod
315             #pod =cut
316              
317             sub delta_not_within($$$;$) { ## no critic
318 7     7 1 5493 my ( $p, $q, $epsilon, $name ) = @_;
319 7 100 66     144 croak "Value of epsilon to delta_not_within must be non-zero"
320             if !defined($epsilon) || $epsilon == 0;
321             {
322 6         4 local $Test::Builder::Level = $Test::Builder::Level + 1;
  6         10  
323 6         9 _delta_not_within( $p, $q, $epsilon, $name );
324             }
325             }
326              
327             sub _delta_not_within($$$;$) { ## no critic
328 25     25   36 my ( $p, $q, $epsilon, $name ) = @_;
329 25         42 my ( $ok, undef, @indices ) = _check( $p, $q, $epsilon, $name );
330 25         35 $ok = !$ok;
331 25         40 my ( $ep, $dp ) = _ep_dp($epsilon);
332 25 100       85 my $diag =
333             defined($epsilon)
334             ? sprintf( "Arguments are equal to within %.${ep}f", abs($epsilon) )
335             : _diag_default();
336 25   66     71 return $Test->ok( $ok, $name ) || $Test->diag($diag);
337             }
338              
339             #pod =head2 delta_not_ok
340             #pod
341             #pod delta_not_ok( $p, $q, '$p and $q are different' );
342             #pod delta_not_ok( \@p, \@q, '@p and @q are different' );
343             #pod
344             #pod This function tests for inequality in excess of a default epsilon value. See
345             #pod L for details on changing the default. Otherwise, this function works
346             #pod the same as C.
347             #pod
348             #pod =cut
349              
350             sub delta_not_ok($$;$) { ## no critic
351 19     19 1 16944 my ( $p, $q, $name ) = @_;
352             {
353 19         25 local $Test::Builder::Level = $Test::Builder::Level + 1;
  19         33  
354 19         42 _delta_not_within( $p, $q, undef, $name );
355             }
356             }
357              
358             1;
359              
360             __END__