t/RNG.t

   1 package Math::GSL::RNG::Test;
   2 use base q{Test::Class};
   3 use Test::More tests => 32;
   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(2) {
  73     my $rng = Math::GSL::RNG->new;
  74     my $x   = $rng->get;
  75     ok( defined $x, '$rng->get' );
  76     my @values = $rng->get(10);
  77     ok( @values == 10, 'got 10 values from get->(10)');
  78 }
  79
  80 sub GSL_RNG_NAME : Tests {
  81     my $self  = shift;
  82     my $name1 = gsl_rng_name($self->{rng});
  83     ok( defined $name1 , "\$gsl_rng_default=$name1" );
  84
  85     my $rng   = Math::GSL::RNG->new;
  86     my $name2 = $rng->name;
  87     ok($name1 eq $name2, "\$rng->name == gsl_rng_name = $name2" );
  88 }
  89
  90 sub GSL_RNG_SIZE : Tests {
  91     my $self  = shift;
  92     my $size = gsl_rng_size($self->{rng});
  93     ok( $size > 0, 'gsl_rng_size' );
  94 }
  95
  96 sub GSL_RNG_MIN_AND_MAX : Tests {
  97     my $self  = shift;
  98     my $rng = $self->{rng};
  99     my ($min,$max) = (gsl_rng_min($rng), gsl_rng_max($rng));
 100     map { gsl_rng_get($rng) } (1..int(rand(100)));
 101     ok( defined $min && defined $max
 102         && ($min <= $max), 'gsl_rng_min and gsl_rng_max');
 103 }
 104
 105 sub GSL_RNG_NO_MORE_SECRETS : Tests {
 106     my $seed = 1+int 10*rand;
 107     my $k    = 10 + int(100*rand);
 108     my $rng1 = Math::GSL::RNG->new($gsl_rng_knuthran, $seed );
 109     my $rng2 = Math::GSL::RNG->new($gsl_rng_knuthran, $seed );
 110
 111     # throw away the first $k values
 112     map {  $rng1->get && $rng2->get } (1..$k);
 113
 114     my ($n1,$n2) = ( $rng1->get , $rng2->get );
 115     ok( $n1 == $n2 , "parrallel state test: $n1 ?= $n2" );
 116 }
 117
 118 sub GSL_RNG_DEFAULT : Tests {
 119     my $self = shift;
 120     my $seed = 42;
 121
 122     my $rng = gsl_rng_alloc($gsl_rng_default);
 123     isa_ok( $rng, 'Math::GSL::RNG', 'gsl_rng_alloc' );
 124
 125     eval { gsl_rng_set($rng, $seed) };
 126     isa_ok( $rng, 'Math::GSL::RNG', 'gsl_rng_set' );
 127     ok( ! $@, 'gsl_rng_set' );
 128
 129     my $rand = gsl_rng_get($rng);
 130     ok( defined $rand && $rand == 1608637542, 'gsl_rng_get' );
 131
 132     my $rng2 = gsl_rng_alloc($gsl_rng_default);
 133
 134     eval { gsl_rng_memcpy($rng2, $rng) };
 135     ok ( ! $@, 'gsl_rng_memcpy' );
 136
 137     eval { Math::GSL::RNG::gsl_rng_free($rng) };
 138     ok( ! $@, 'gsl_rng_free' );
 139 }
 140
 141 sub GSL_RNG_FWRITE_FREAD : Tests {
 142     my $self = shift;
 143     my $rng = gsl_rng_alloc($gsl_rng_default);
 144
 145     my $fh = gsl_fopen("rng" , 'w');
 146     ok_status(gsl_rng_fwrite($fh, $self->{rng}));
 147     ok_status(gsl_fclose($fh));
 148
 149     $fh = gsl_fopen("rng", 'r');
 150     is(gsl_rng_fread($fh, $rng),0);
 151     is(gsl_rng_get($rng), gsl_rng_get($self->{rng}));
 152     ok_status(gsl_fclose($fh));
 153 }
 154 Test::Class->runtests;