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