|  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__  |