File Coverage

blib/lib/Math/Random/MT/Perl.pm

Criterion	Covered	Total	%
statement	130	130	100.0
branch	24	26	92.3
condition	10	10	100.0
subroutine	20	20	100.0
pod	6	6	100.0
total	190	192	98.9

package Math::Random::MT::Perl;

use strict;
use warnings;

use vars qw($VERSION);
$VERSION = 1.15;

my $N = 624;
my $M = 397;
my $UP_MASK  = 0x80000000;
my $LOW_MASK = 0x7fffffff;

my $gen = undef;


sub new {
    # Create a Math::Random::MT::Perl object
    my ($class, @seeds) = @_;
    my $self = {};
    bless $self, $class;
    # Seed the random number generator
    $self->set_seed(@seeds);
    return $self;
}


sub rand {
    # Generate a random number in requested range
    my ($self, $range) = @_;
    if (ref $self) {
        return ($range || 1) * $self->_mt_genrand();
    }
    else {
        $range = $self;
        Math::Random::MT::Perl::srand() unless defined $gen;
        return ($range || 1) * $gen->_mt_genrand();
    }
}


sub irand {
    # Generate a random integer
    my ($self) = @_;
    if (ref $self) {
        return $self->_mt_genirand();
    }
    else {
        Math::Random::MT::Perl::srand() unless defined $gen;
        return $gen->_mt_genirand();
    }
}


sub get_seed {
    # Get the seed
    my ($self) = @_;
    return $self->{seed};
}


sub set_seed {
    # Set the seed
    my ($self, @seeds) = @_;
    $self->{mt} = undef;
    $self->{mti} = undef;
    $self->{seed} = undef;
    @seeds > 1 ? $self->_mt_setup_array(@seeds) :
                 $self->_mt_init_seed(defined $seeds[0] ? $seeds[0] : _rand_seed());
    return $self->{seed};
}


sub srand {
    # Seed the random number generator, automatically generating a seed if none
    # is provided
    my (@seeds) = @_;
    if (not @seeds) {
      $seeds[0] = _rand_seed();
    }
    $gen = Math::Random::MT::Perl->new(@seeds);
    my $seed = $gen->get_seed;
    return $seed;
}


sub _rand_seed {
    my ($self) = @_;

    # Get a seed at random through Perl's CORE::rand(). We do not call
    # CORE::srand() to avoid altering the random numbers that other parts of
    # the running script might be using. The seeds obtained by rapid calls to
    # the _rand_seed() function are all different.

    return int(CORE::rand(2**32));
}


# Note that we need to use integer some of the time to force integer overflow
# rollover ie 2**32+1 => 0. Unfortunately we really want uint but integer
# casts to signed ints, thus we can't do everything within an integer block,
# specifically the bitshift xor functions below. The & 0xffffffff is required
# to constrain the integer to 32 bits on 64 bit systems.

sub _mt_init_seed {
    my ($self, $seed) = @_;
    my @mt;
    $mt[0] = $seed & 0xffffffff;
    for ( my $i = 1; $i < $N; $i++ ) {
        my $xor = $mt[$i-1]^($mt[$i-1]>>30);
        { use integer; $mt[$i] = (1812433253 * $xor + $i) & 0xffffffff }
    }
    $self->{mt} = \@mt;
    $self->{mti} = $N;
    $self->{seed} = ${$self->{mt}}[0];
}


sub _mt_setup_array {
    my ($self, @seeds) = @_;
    @seeds = map{ $_ & 0xffffffff }@seeds;  # limit seeds to 32 bits
    $self->_mt_init_seed( 19650218 );
    my @mt = @{$self->{mt}};
    my $i = 1;
    my $j = 0;
    my $n = @seeds;
    my $k = $N > $n ? $N : $n;
    my ($uint32, $xor);
    for (; $k; $k--) {
        $xor = $mt[$i-1] ^ ($mt[$i-1] >> 30);
        { use integer; $uint32 = ($xor * 1664525) & 0xffffffff }
        $mt[$i] = ($mt[$i] ^ $uint32);
        { use integer; $mt[$i] = ($mt[$i] + $seeds[$j] + $j) & 0xffffffff }
        $i++; $j++;
        if ($i>=$N) { $mt[0] = $mt[$N-1]; $i=1; }
        if ($j>=$n) { $j=0; }
    }
    for ($k=$N-1; $k; $k--) {
        $xor = $mt[$i-1] ^ ($mt[$i-1] >> 30);
        { use integer; $uint32 = ($xor * 1566083941) & 0xffffffff }
        $mt[$i] = ($mt[$i] ^ $uint32) - $i;
        $i++;
        if ($i>=$N) { $mt[0] = $mt[$N-1]; $i=1; }
    }
    $mt[0] = 0x80000000;
    $self->{mt} = \@mt;
    $self->{seed} = ${$self->{mt}}[0];
}


sub _mt_genrand {
    my ($self) = @_;
    return $self->_mt_genirand*(1.0/4294967296.0);
}


sub _mt_genirand {
    my ($self) = @_;
    my ($kk, $y);
    my @mag01 = (0x0, 0x9908b0df);
    if ($self->{mti} >= $N) {
        for ($kk = 0; $kk < $N-$M; $kk++) {
            $y = ($self->{mt}->[$kk] & $UP_MASK) | ($self->{mt}->[$kk+1] & $LOW_MASK);
            $self->{mt}->[$kk] = $self->{mt}->[$kk+$M] ^ ($y >> 1) ^ $mag01[$y & 1];
        }
        for (; $kk < $N-1; $kk++) {
            $y = ($self->{mt}->[$kk] & $UP_MASK) | ($self->{mt}->[$kk+1] & $LOW_MASK);
            $self->{mt}->[$kk] = $self->{mt}->[$kk+($M-$N)] ^ ($y >> 1) ^ $mag01[$y & 1];
        }
        $y = ($self->{mt}->[$N-1] & $UP_MASK) | ($self->{mt}->[0] & $LOW_MASK);
        $self->{mt}->[$N-1] = $self->{mt}->[$M-1] ^ ($y >> 1) ^ $mag01[$y & 1];
        $self->{mti} = 0;
    }
    $y  = $self->{mt}->[$self->{mti}++];
    $y ^= $y >> 11;
    $y ^= ($y <<  7) & 0x9d2c5680;
    $y ^= ($y << 15) & 0xefc60000;
    $y ^= $y >> 18;
    return $y;
}


sub import {
    no strict 'refs';
    my $pkg = caller;
    for my $sym (@_) {
       *{"${pkg}::$sym"} = \&$sym  if $sym eq "srand" or $sym eq "rand" or $sym eq "irand";
    }
}


1;

__END__