t/RNG.t

   1 package Math::GSL::RNG::Test;
   2 use base q{Test::Class};
   3 use Test::More tests => 31;
   4 use Math::GSL        qw/:all/;
   5 use Math::GSL::RNG   qw/:all/;
   6 use Math::GSL::Test  qw/:all/;
   7 use Math::GSL::Errno qw/:all/;
   8 use Data::Dumper;
   9 use strict;
  10
  11 sub make_fixture : Test(setup) {
  12     my $self = shift;
  13     $self->{rng} = gsl_rng_alloc($gsl_rng_default);
  14     gsl_rng_set( $self->{rng}, 1 + 9*(int rand) );
  15 }
  16
  17 sub teardown : Test(teardown) {
  18     my $self = shift;
  19     unlink 'rng' if -f 'rng';
  20
  21     gsl_rng_free($self->{rng});
  22 }
  23
  24 sub GSL_RNG_TYPE : Tests {
  25     my $self = shift;
  26     my $type = Math::GSL::RNG::gsl_rng_type->new;
  27     isa_ok( $type, 'Math::GSL::RNG::gsl_rng_type', 'gsl_rng_type' );
  28 }
  29
  30 sub GSL_RNG_ALLOC : Tests {
  31     for my $rngtype ( $gsl_rng_random256_bsd, $gsl_rng_knuthran,
  32                       $gsl_rng_transputer, $gsl_rng_knuthran2002) {
  33         my $rng;
  34         eval { $rng = gsl_rng_alloc($rngtype) };
  35         isa_ok( $rng, 'Math::GSL::RNG');
  36         ok( !$@ ,'gsl_rng_alloc');
  37     }
  38 }
  39
  40 sub GSL_RNG_NEW: Tests {
  41     my $rng;
  42     $rng = Math::GSL::RNG->new($gsl_rng_knuthran, int 10*rand);
  43     isa_ok($rng, 'Math::GSL::RNG' );
  44
  45     $rng = Math::GSL::RNG->new($gsl_rng_knuthran);
  46     isa_ok($rng, 'Math::GSL::RNG' );
  47
  48     $rng = Math::GSL::RNG->new;
  49     isa_ok($rng, 'Math::GSL::RNG' );
  50 }
  51
  52 sub GSL_RNG_METHODS : Tests {
  53     can_ok('Math::GSL::RNG', qw/copy get new free/ );
  54 }
  55
  56 sub GSL_RNG_STATE : Tests {
  57     my $seed = int 10*rand;
  58     my $k    = 10 + int(100*rand);
  59     my $rng1 = Math::GSL::RNG->new($gsl_rng_knuthran, $seed );
  60
  61     map { my $x = $rng1->get } (1..$k);
  62
  63     my $rng2 = Math::GSL::RNG->new($gsl_rng_knuthran, $seed );
  64     $rng2 = $rng1->copy;
  65
  66     my @vals1 = map { $rng1->get } (1..$k);
  67     my @vals2 = map { $rng2->get } (1..$k);
  68
  69     is_deeply( [@vals1], [@vals2], "state test, $#vals1 values checked");
  70 }
  71
  72 sub GSL_RNG_GET : Tests {
  73     my $rng = Math::GSL::RNG->new;
  74     my $x   = $rng->get;
  75     ok( defined $x, '$rng->get' );
  76 }
  77
  78 sub GSL_RNG_NAME : Tests {
  79     my $self  = shift;
  80     my $name1 = gsl_rng_name($self->{rng});
  81     ok( defined $name1 , "\$gsl_rng_default=$name1" );
  82
  83     my $rng   = Math::GSL::RNG->new;
  84     my $name2 = $rng->name;
  85     ok($name1 eq $name2, "\$rng->name == gsl_rng_name = $name2" );
  86 }
  87
  88 sub GSL_RNG_SIZE : Tests {
  89     my $self  = shift;
  90     my $size = gsl_rng_size($self->{rng});
  91     ok( $size > 0, 'gsl_rng_size' );
  92 }
  93
  94 sub GSL_RNG_MIN_AND_MAX : Tests {
  95     my $self  = shift;
  96     my $rng = $self->{rng};
  97     my ($min,$max) = (gsl_rng_min($rng), gsl_rng_max($rng));
  98     map { gsl_rng_get($rng) } (1..int(rand(100)));
  99     ok( defined $min && defined $max
 100         && ($min <= $max), 'gsl_rng_min and gsl_rng_max');
 101 }
 102
 103 sub GSL_RNG_NO_MORE_SECRETS : Tests {
 104     my $seed = 1+int 10*rand;
 105     my $k    = 10 + int(100*rand);
 106     my $rng1 = Math::GSL::RNG->new($gsl_rng_knuthran, $seed );
 107     my $rng2 = Math::GSL::RNG->new($gsl_rng_knuthran, $seed );
 108
 109     # throw away the first $k values
 110     map {  $rng1->get && $rng2->get } (1..$k);
 111
 112     my ($n1,$n2) = ( $rng1->get , $rng2->get );
 113     ok( $n1 == $n2 , "parrallel state test: $n1 ?= $n2" );
 114 }
 115
 116 sub GSL_RNG_DEFAULT : Tests {
 117     my $self = shift;
 118     my $seed = 42;
 119
 120     my $rng = gsl_rng_alloc($gsl_rng_default);
 121     isa_ok( $rng, 'Math::GSL::RNG', 'gsl_rng_alloc' );
 122
 123     eval { gsl_rng_set($rng, $seed) };
 124     isa_ok( $rng, 'Math::GSL::RNG', 'gsl_rng_set' );
 125     ok( ! $@, 'gsl_rng_set' );
 126
 127     my $rand = gsl_rng_get($rng);
 128     ok( defined $rand && $rand == 1608637542, 'gsl_rng_get' );
 129
 130     my $rng2 = gsl_rng_alloc($gsl_rng_default);
 131
 132     eval { gsl_rng_memcpy($rng2, $rng) };
 133     ok ( ! $@, 'gsl_rng_memcpy' );
 134
 135     eval { Math::GSL::RNG::gsl_rng_free($rng) };
 136     ok( ! $@, 'gsl_rng_free' );
 137 }
 138
 139 sub GSL_RNG_FWRITE_FREAD : Tests {
 140     my $self = shift;
 141     my $rng = gsl_rng_alloc($gsl_rng_default);
 142
 143     my $fh = gsl_fopen("rng" , 'w');
 144     ok_status(gsl_rng_fwrite($fh, $self->{rng}));
 145     ok_status(gsl_fclose($fh));
 146
 147     $fh = gsl_fopen("rng", 'r');
 148     is(gsl_rng_fread($fh, $rng),0);
 149     is(gsl_rng_get($rng), gsl_rng_get($self->{rng}));
 150     ok_status(gsl_fclose($fh));
 151 }
 152 Test::Class->runtests;