Parent Directory
| 
Revision Log
Revision 413 - (view) (download) (as text)
| 1 : | sh002i | 413 | #! /usr/math/bin/perl -w |
| 2 : | |||
| 3 : | |||
| 4 : | package PGrandom; | ||
| 5 : | |||
| 6 : | |||
| 7 : | use strict; | ||
| 8 : | |||
| 9 : | my $multiplier = 69069; | ||
| 10 : | |||
| 11 : | my $translate = 1; | ||
| 12 : | |||
| 13 : | my $modulus = 2**32; | ||
| 14 : | |||
| 15 : | sub new { | ||
| 16 : | my $class = shift; | ||
| 17 : | my $seed = shift; | ||
| 18 : | |||
| 19 : | $seed = 1 unless defined($seed); | ||
| 20 : | my $original_seed = $seed; | ||
| 21 : | $seed = mod ($multiplier * $seed + $translate, $modulus); | ||
| 22 : | my $self = { 'seed' => $seed, | ||
| 23 : | 'original_seed' => $original_seed, # this and the next value are largely for debugging | ||
| 24 : | 'number_of_calls' => 1 # there is always one call to set the seed. | ||
| 25 : | }; | ||
| 26 : | |||
| 27 : | bless $self, $class; | ||
| 28 : | |||
| 29 : | return $self; | ||
| 30 : | } | ||
| 31 : | sub mod { # for some reason perl's % doesn't seem to work for large numbers? | ||
| 32 : | my $a = shift; | ||
| 33 : | my $b = shift; | ||
| 34 : | $a - int($a/$b)*$b; | ||
| 35 : | } | ||
| 36 : | |||
| 37 : | sub random { | ||
| 38 : | my $self = shift; | ||
| 39 : | my $begin = shift; | ||
| 40 : | my $end = shift; | ||
| 41 : | my $incr = shift; | ||
| 42 : | my $out; | ||
| 43 : | $self->{'number_of_calls'}++; | ||
| 44 : | $incr = 1 unless defined($incr); | ||
| 45 : | my $seed = $self->{'seed'}; | ||
| 46 : | my $new_seed = mod ($multiplier * $seed + $translate, $modulus) ; | ||
| 47 : | $self->{'seed'} = $new_seed; | ||
| 48 : | unless ( $incr <= 0 ) { | ||
| 49 : | $out = $begin +$incr*int( ($new_seed/($modulus))*( ($end-$begin)/$incr +1 ) ) ; | ||
| 50 : | } else { # if $incr is less than zero return "continuous" distribution | ||
| 51 : | $out = $begin + ($end-$begin)*$new_seed/$modulus; | ||
| 52 : | } | ||
| 53 : | $out; | ||
| 54 : | |||
| 55 : | } | ||
| 56 : | sub rand { | ||
| 57 : | my $self = shift; | ||
| 58 : | my $end = shift; | ||
| 59 : | $end = 1 unless defined($end); | ||
| 60 : | $self->random(0,$end,0); | ||
| 61 : | } | ||
| 62 : | |||
| 63 : | sub srand { | ||
| 64 : | my $self = shift; | ||
| 65 : | my $new_seed = shift; | ||
| 66 : | $self->{'original_seed'} = $new_seed; | ||
| 67 : | $new_seed= mod ($multiplier * $new_seed + $translate, $modulus) ; # reset the seed | ||
| 68 : | $self->{'number_of_calls'}=1; | ||
| 69 : | $self->{'seed'} = $new_seed; | ||
| 70 : | } | ||
| 71 : | sub seed { #synonym for srand | ||
| 72 : | my $self = shift; | ||
| 73 : | $self->srand(@_); | ||
| 74 : | } | ||
| 75 : | |||
| 76 : | 1; |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |