1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
###############################################
# A simple Perl module for using CDF files
#
# Tim Buchheim, 25 September 2002
#
# based on C++ code found in the ns project
#
# File format:
#
# first column: value
# second column: cumulative number of occurances (ignored)
# third column: cumulative probability
#
###############################################
package CDF;
use strict;
# the constructor
#
# $foo = new CDF($filename);
#
sub new {
my $class = shift;
my $i = 0;
my $file = shift;
my @table;
open INPUT_FILE, $file or die "Unable to open file: $file";
while (<INPUT_FILE>) {
my ($value, $num, $prob) = split;
$table[$i] = [$prob, $value];
++$i;
}
close INPUT_FILE;
return bless \@table, $class;
}
# public methods
#
# $foo->value();
#
# looks up the value for a random number. Does not do any interpolation.
sub value {
my $self = shift;
my @table = @$self;
if (scalar(@table) <= 0) { return 0; }
my $u = rand;
my $mid = $self->lookup($u);
return $table[$mid][1];
}
#
# $foo->interpolated_value();
#
# looks up the value for a random number. Interpolates between table
# entries.
sub interpolated_value {
my $self = shift;
my @table = @$self;
if (scalar(@table) <= 0) { return 0; }
my $u = rand;
my $mid = $self->lookup($u);
if ($mid and $u < $table[$mid][0]) {
return interpolate($u, $table[$mid-1][0], $table[$mid-1][1],
$table[$mid][0], $table[$mid][1]);
}
return $table[$mid][1];
}
# private method
sub lookup {
my $self = shift;
my @table = @$self;
my $u = shift;
if ($u <= $table[0][0]) {
return 0;
}
my ($lo, $hi, $mid);
for ($lo = 1, $hi = scalar(@table) - 1; $lo < $hi; ) {
$mid = ($lo + $hi) / 2;
if ($u > $table[$mid][0]) {
$lo = $mid + 1;
} else {
$hi = $mid;
}
}
return $lo;
}
# private function
sub interpolate {
my ($x, $x1, $y1, $x2, $y2) = @_;
my $value = $y1 + ($x - $x1) * ($y2 - $y1) / ($x2 - $x1);
return $value;
}
# a Perl package must return true
1;
|
