Permalink
Fetching contributors…
Cannot retrieve contributors at this time
85 lines (71 sloc) 2.56 KB
package Math::GSL::Monte::Test;
use base q{Test::Class};
use Test::More tests => 15;
use Math::GSL::Monte qw/:all/;
use Math::GSL::Errno qw/:all/;
use Math::GSL::RNG qw/:all/;
use Math::GSL::Test qw/:all/;
use Data::Dumper;
use strict;
BEGIN { gsl_set_error_handler_off() }
sub make_fixture : Test(setup) {
my $self = shift;
my $j = 1 + int(rand(20));
$self->{miser} = gsl_monte_miser_alloc($j);
$self->{vegas} = gsl_monte_vegas_alloc($j);
$self->{plain} = gsl_monte_plain_alloc($j);
$self->{dim} = $j;
}
sub teardown : Test(teardown) {
my $self = shift;
gsl_monte_miser_free($self->{miser});
gsl_monte_plain_free($self->{plain});
gsl_monte_vegas_free($self->{vegas});
}
sub TEST_INIT : Tests(3) {
my $self = shift;
ok_status( gsl_monte_plain_init($self->{plain}), $GSL_SUCCESS, 'plain' );
ok_status( gsl_monte_vegas_init($self->{vegas}), $GSL_SUCCESS, 'vegas' );
ok_status( gsl_monte_miser_init($self->{miser}), $GSL_SUCCESS, 'miser' );
}
sub TEST_MONTE_VEGAS_STATE : Tests {
my $state = Math::GSL::Monte::gsl_monte_vegas_state->new;
isa_ok($state, 'Math::GSL::Monte::gsl_monte_vegas_state');
}
sub TEST_MONTE_VEGAS_STATE_DIM : Tests {
my $state = Math::GSL::Monte::gsl_monte_vegas_state->new;
$state->swig_dim_set(1);
cmp_ok( $state->swig_dim_get , '==', 1, 'swig_dim_set' );
}
sub TEST_MONTE_PLAIN_INTEGRATE : Tests {
my $state = gsl_monte_plain_alloc(1);
my $rng = Math::GSL::RNG->new;
my ($status, @stuff) = gsl_monte_plain_integrate( sub { exp(-$_[0] ** 2) },
[ -1 ], [ 2 ], 1, 1000, $rng->raw, $state);
ok_status($status);
#warn Dumper [ @stuff ];
}
sub TEST_MONTE_VEGAS_INTEGRATE : Tests(3) {
my $self = shift;
my $state = gsl_monte_vegas_alloc(1);
my $rng = Math::GSL::RNG->new;
my ($status, @stuff);
($status, @stuff) = gsl_monte_vegas_integrate( sub { $_[0] ** 2 },
[ 0 ], [ 1 ], 1, 100, $rng->raw, $state);
ok( $state->{dim} == 1, 'dim = 1');
#warn Dumper [ @stuff ];
#warn Dumper [ $status, $state, $state->{result} ];
ok_status($status);
local $TODO = 'result of Monte carlo needs fixin';
ok_similar( [ 1/3 ] , [ $state->{result} ] );
}
sub TEST_ALLOC : Tests(6) {
my $self = shift;
isa_ok($self->{miser},'Math::GSL::Monte');
cmp_ok($self->{miser}->{dim},'==',$self->{dim});
isa_ok($self->{vegas},'Math::GSL::Monte');
cmp_ok($self->{vegas}->{dim},'==',$self->{dim});
isa_ok($self->{plain},'Math::GSL::Monte');
cmp_ok($self->{plain}->{dim},'==',$self->{dim});
}
Test::Class->runtests;