PageRenderTime 63ms CodeModel.GetById 19ms RepoModel.GetById 1ms app.codeStats 0ms

/ns-2.34/indep-utils/model-gen/CDF.pm

http://uu-cope.googlecode.com/
Perl | 119 lines | 60 code | 28 blank | 31 comment | 8 complexity | 0ea9299706ab78fb8c9c668e2292c051 MD5 | raw file
Possible License(s): LGPL-2.0
  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;