File Coverage

blib/lib/Math/Erf/Approx.pm
Criterion Covered Total %
statement 49 53 92.4
branch 2 4 50.0
condition 1 2 50.0
subroutine 13 13 100.0
pod 3 3 100.0
total 68 75 90.6


line stmt bran cond sub pod time code
1             package Math::Erf::Approx;
2              
3 3     3   54960 use 5.010;
  3         10  
  3         109  
4 3     3   18 use strict;
  3         4  
  3         109  
5 3     3   14 use warnings;
  3         10  
  3         102  
6 3     3   15 use Scalar::Util qw< blessed >;
  3         12  
  3         495  
7 3     3   6476 use Sub::Exporter -setup => { exports => [qw< erf erfc >] };
  3         58900  
  3         28  
8 3     3   2170 use Test::More;
  3         21550  
  3         38  
9              
10             BEGIN {
11 3     3   1050 no warnings 'once';
  3         7  
  3         174  
12 3     3   7 $Math::Erf::Approx::AUTHORITY = 'cpan:TOBYINK';
13 3         1455 $Math::Erf::Approx::VERSION = '0.001';
14             };
15              
16             sub erf
17             {
18 92     92 1 153 my ($x) = @_;
19            
20 92 50       405 if ($x < 0)
21             {
22 0         0 return -erf(-$x);
23             }
24            
25 92         247 my @a = qw< 1.0 0.278393 0.230389 0.000972 0.078108>;
26            
27 92         114 my $sum;
28 92         176 for my $i (0 .. 4)
29             {
30 460         1449 $sum += $a[$i] * ($x ** $i);
31             }
32            
33 92         463 1.0 - ($sum ** -4);
34             }
35              
36             sub erfc
37             {
38 46     46 1 84 my ($x, $erf) = @_;
39 46   50     232 $erf //= \&erf;
40 46         92 1.0 - $erf->($x);
41             }
42              
43              
44             sub _test_cases
45             {
46 1     1   32 my @numbers = grep { /\d/ } split /\s+/, q{
  139         325  
47             0.00 0.0000000 1.0000000 1.30 0.9340079 0.0659921
48             0.05 0.0563720 0.9436280 1.40 0.9522851 0.0477149
49             0.10 0.1124629 0.8875371 1.50 0.9661051 0.0338949
50             0.15 0.1679960 0.8320040 1.60 0.9763484 0.0236516
51             0.20 0.2227026 0.7772974 1.70 0.9837905 0.0162095
52             0.25 0.2763264 0.7236736 1.80 0.9890905 0.0109095
53             0.30 0.3286268 0.6713732 1.90 0.9927904 0.0072096
54             0.35 0.3793821 0.6206179 2.00 0.9953223 0.0046777
55             0.40 0.4283924 0.5716076 2.10 0.9970205 0.0029795
56             0.45 0.4754817 0.5245183 2.20 0.9981372 0.0018628
57             0.50 0.5204999 0.4795001 2.30 0.9988568 0.0011432
58             0.55 0.5633234 0.4366766 2.40 0.9993115 0.0006885
59             0.60 0.6038561 0.3961439 2.50 0.9995930 0.0004070
60             0.65 0.6420293 0.3579707 2.60 0.9997640 0.0002360
61             0.70 0.6778012 0.3221988 2.70 0.9998657 0.0001343
62             0.75 0.7111556 0.2888444 2.80 0.9999250 0.0000750
63             0.80 0.7421010 0.2578990 2.90 0.9999589 0.0000411
64             0.85 0.7706681 0.2293319 3.00 0.9999779 0.0000221
65             0.90 0.7969082 0.2030918 3.10 0.9999884 0.0000116
66             0.95 0.8208908 0.1791092 3.20 0.9999940 0.0000060
67             1.00 0.8427008 0.1572992 3.30 0.9999969 0.0000031
68             1.10 0.8802051 0.1197949 3.40 0.9999985 0.0000015
69             1.20 0.9103140 0.0896860 3.50 0.9999993 0.0000007
70             };
71            
72 1         8 my @test_cases;
73 1         5 while (@numbers)
74             {
75 46         142 push @test_cases, [shift @numbers, shift @numbers, shift @numbers];
76             }
77            
78 1         11 return @test_cases;
79             }
80              
81             sub _close_enough
82             {
83 92     92   138 my ($x, $y) = @_;
84 92         195 my $err = abs($x - $y);
85 92 50       535 return 1 if $err < 0.0005;
86 0         0 diag "Got: $x";
87 0         0 diag "Expected $y";
88 0         0 return;
89             }
90              
91             sub run_tests
92             {
93 1     1 1 14 my ($class) = @_;
94 1         6 my @cases = $class->_test_cases;
95            
96 1         11 plan tests => (2 * @cases);
97            
98 1         694 foreach my $tc (@cases)
99             {
100 46         21445 my ($x, $erf, $erfc) = @$tc;
101 46         115 ok _close_enough(erf($x), $erf), "erf($x)";
102 46         22810 ok _close_enough(erfc($x), $erfc), "erfc($x)";
103             }
104             }
105              
106             caller(0) or __PACKAGE__->run_tests;
107             __END__