CDF.pm
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:2k
源码类别:

通讯编程

开发平台:

Visual C++

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