File Coverage

blib/lib/Math/Random/OO/Normal.pm
Criterion Covered Total %
statement 47 49 95.9
branch 9 10 90.0
condition 2 2 100.0
subroutine 10 10 100.0
pod 3 3 100.0
total 71 74 95.9


line stmt bran cond sub pod time code
1 3     3   39274 use 5.006;
  3         10  
  3         133  
2 3     3   16 use strict;
  3         6  
  3         99  
3 3     3   17 use warnings;
  3         7  
  3         181  
4              
5             package Math::Random::OO::Normal;
6             # ABSTRACT: Generates random numbers from the normal (Gaussian) distribution
7             our $VERSION = '0.22'; # VERSION
8              
9             # Required modules
10 3     3   17 use Carp;
  3         12  
  3         214  
11 3     3   1077 use Params::Validate ':all';
  3         23273  
  3         747  
12              
13             # ISA
14 3     3   21 use base qw( Class::Accessor::Fast );
  3         7  
  3         2552  
15              
16              
17             {
18             my $param_spec = {
19             mean => { type => SCALAR },
20             stdev => { type => SCALAR }
21             };
22              
23             __PACKAGE__->mk_accessors( keys %$param_spec );
24             #__PACKAGE__->mk_ro_accessors( keys %$param_spec );
25              
26             sub new {
27 8     8 1 2349 my $class = shift;
28 8 100       45 my $self = bless {}, ref($class) ? ref($class) : $class;
29 8 100       32 if ( @_ > 1 ) {
    100          
30 3         14 $self->mean( $_[0] );
31 3         36 $self->stdev( abs( $_[1] ) );
32             }
33             elsif ( @_ == 1 ) {
34 1         4 $self->mean( $_[0] );
35 1         8 $self->stdev(1);
36             }
37             else {
38 4         18 $self->mean(0);
39 4         103 $self->stdev(1);
40             }
41 8         58 return $self;
42             }
43             }
44              
45              
46             sub seed {
47 17     17 1 3922 my $self = shift;
48 17         53 srand( $_[0] );
49             }
50              
51              
52             sub next {
53 34     34 1 360 my ($self) = @_;
54 34   100     93 my $rnd = rand() || 1e-254; # can't have zero for normals
55 34         310 return _ltqnorm($rnd) * $self->stdev + $self->mean;
56             }
57              
58             #--------------------------------------------------------------------------#
59             # Function for inverse cumulative normal
60             # Used with permission
61             # http://home.online.no/~pjacklam/notes/invnorm/impl/acklam/perl/
62             #
63             # Input checking removed by DAGOLDEN as the input will be prechecked
64             #--------------------------------------------------------------------------#
65              
66             #<<< No perltidy
67             sub _ltqnorm {
68             # Lower tail quantile for standard normal distribution function.
69             #
70             # This function returns an approximation of the inverse cumulative
71             # standard normal distribution function. I.e., given P, it returns
72             # an approximation to the X satisfying P = Pr{Z <= X} where Z is a
73             # random variable from the standard normal distribution.
74             #
75             # The algorithm uses a minimax approximation by rational functions
76             # and the result has a relative error whose absolute value is less
77             # than 1.15e-9.
78             #
79             # Author: Peter J. Acklam
80             # Time-stamp: 2000-07-19 18:26:14
81             # E-mail: pjacklam@online.no
82             # WWW URL: http://home.online.no/~pjacklam
83              
84 34     34   52 my $p = shift;
85             # DAGOLDEN: arg checking will be done earlier
86             # die "input argument must be in (0,1)\n" unless 0 < $p && $p < 1;
87              
88             # Coefficients in rational approximations.
89 34         71 my @a = (-3.969683028665376e+01, 2.209460984245205e+02,
90             -2.759285104469687e+02, 1.383577518672690e+02,
91             -3.066479806614716e+01, 2.506628277459239e+00);
92 34         67 my @b = (-5.447609879822406e+01, 1.615858368580409e+02,
93             -1.556989798598866e+02, 6.680131188771972e+01,
94             -1.328068155288572e+01 );
95 34         68 my @c = (-7.784894002430293e-03, -3.223964580411365e-01,
96             -2.400758277161838e+00, -2.549732539343734e+00,
97             4.374664141464968e+00, 2.938163982698783e+00);
98 34         66 my @d = ( 7.784695709041462e-03, 3.224671290700398e-01,
99             2.445134137142996e+00, 3.754408661907416e+00);
100              
101             # Define break-points.
102 34         40 my $plow = 0.02425;
103 34         46 my $phigh = 1 - $plow;
104              
105             # Rational approximation for lower region:
106 34 100       74 if ( $p < $plow ) {
107 1         10 my $q = sqrt(-2*log($p));
108 1         11 return ((((($c[0]*$q+$c[1])*$q+$c[2])*$q+$c[3])*$q+$c[4])*$q+$c[5]) /
109             (((($d[0]*$q+$d[1])*$q+$d[2])*$q+$d[3])*$q+1);
110             }
111              
112             # Rational approximation for upper region:
113 33 50       74 if ( $phigh < $p ) {
114 0         0 my $q = sqrt(-2*log(1-$p));
115 0         0 return -((((($c[0]*$q+$c[1])*$q+$c[2])*$q+$c[3])*$q+$c[4])*$q+$c[5]) /
116             (((($d[0]*$q+$d[1])*$q+$d[2])*$q+$d[3])*$q+1);
117             }
118              
119             # Rational approximation for central region:
120 33         40 my $q = $p - 0.5;
121 33         50 my $r = $q*$q;
122 33         297 return ((((($a[0]*$r+$a[1])*$r+$a[2])*$r+$a[3])*$r+$a[4])*$r+$a[5])*$q /
123             ((((($b[0]*$r+$b[1])*$r+$b[2])*$r+$b[3])*$r+$b[4])*$r+1);
124             }
125             #>>>
126              
127             1;
128              
129             __END__