t/Monte.t

   1 package Math::GSL::Monte::Test;
   2 use base q{Test::Class};
   3 use Test::More tests => 15;
   4 use Math::GSL::Monte qw/:all/;
   5 use Math::GSL::Errno qw/:all/;
   6 use Math::GSL::RNG   qw/:all/;
   7 use Math::GSL::Test  qw/:all/;
   8 use Data::Dumper;
   9 use strict;
  10
  11 BEGIN { gsl_set_error_handler_off() }
  12
  13 sub make_fixture : Test(setup) {
  14     my $self = shift;
  15     my $j          = 1 + int(rand(20));
  16     $self->{miser} = gsl_monte_miser_alloc($j);
  17     $self->{vegas} = gsl_monte_vegas_alloc($j);
  18     $self->{plain} = gsl_monte_plain_alloc($j);
  19     $self->{dim}   = $j;
  20 }
  21
  22 sub teardown : Test(teardown) {
  23     my $self = shift;
  24     gsl_monte_miser_free($self->{miser});
  25     gsl_monte_plain_free($self->{plain});
  26     gsl_monte_vegas_free($self->{vegas});
  27 }
  28
  29 sub TEST_INIT  : Tests(3) {
  30     my $self = shift;
  31     ok_status( gsl_monte_plain_init($self->{plain}), $GSL_SUCCESS, 'plain' );
  32     ok_status( gsl_monte_vegas_init($self->{vegas}), $GSL_SUCCESS, 'vegas' );
  33     ok_status( gsl_monte_miser_init($self->{miser}), $GSL_SUCCESS, 'miser' );
  34 }
  35
  36 sub TEST_MONTE_VEGAS_STATE : Tests {
  37     my $state = Math::GSL::Monte::gsl_monte_vegas_state->new;
  38     isa_ok($state, 'Math::GSL::Monte::gsl_monte_vegas_state');
  39 }
  40
  41 sub TEST_MONTE_VEGAS_STATE_DIM : Tests {
  42     my $state = Math::GSL::Monte::gsl_monte_vegas_state->new;
  43     $state->swig_dim_set(1);
  44     cmp_ok( $state->swig_dim_get , '==', 1, 'swig_dim_set' );
  45 }
  46
  47 sub TEST_MONTE_PLAIN_INTEGRATE : Tests {
  48
  49     my $state = gsl_monte_plain_alloc(1);
  50     my $rng   = Math::GSL::RNG->new;
  51     my ($status, @stuff) =  gsl_monte_plain_integrate( sub { exp(-$_[0] ** 2) },
  52         [ -1 ], [ 2 ], 1, 1000, $rng->raw, $state);
  53     ok_status($status);
  54     #warn Dumper [ @stuff ];
  55
  56 }
  57 sub TEST_MONTE_VEGAS_INTEGRATE : Tests(3) {
  58     my $self = shift;
  59     my $state = gsl_monte_vegas_alloc(1);
  60     my $rng   = Math::GSL::RNG->new;
  61     my ($status, @stuff);
  62     ($status, @stuff) =  gsl_monte_vegas_integrate( sub { $_[0] ** 2 },
  63         [ 0 ], [ 1 ], 1, 100, $rng->raw, $state);
  64
  65     ok( $state->{dim} == 1, 'dim = 1');
  66     #warn Dumper [ @stuff ];
  67     #warn Dumper [ $status, $state, $state->{result} ];
  68     ok_status($status);
  69     local $TODO = 'result of Monte carlo needs fixin';
  70     ok_similar( [ 1/3 ] ,  [ $state->{result} ] );
  71
  72 }
  73 sub TEST_ALLOC : Tests(6) {
  74     my $self = shift;
  75     isa_ok($self->{miser},'Math::GSL::Monte');
  76     cmp_ok($self->{miser}->{dim},'==',$self->{dim});
  77
  78     isa_ok($self->{vegas},'Math::GSL::Monte');
  79     cmp_ok($self->{vegas}->{dim},'==',$self->{dim});
  80
  81     isa_ok($self->{plain},'Math::GSL::Monte');
  82     cmp_ok($self->{plain}->{dim},'==',$self->{dim});
  83 }
  84 Test::Class->runtests;