1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
package Math::GSL::Roots::Test;
use strict;
use warnings;
use base q{Test::Class};
use Test::More tests => 16;
use Math::GSL qw/:all/;
use Math::GSL::Roots qw/:all/;
use Math::GSL::Test qw/:all/;
use Math::GSL::Errno qw/:all/;
use Data::Dumper;
BEGIN { gsl_set_error_handler_off(); }
sub make_fixture : Test(setup) {
my $self = shift;
$self->{solver} = gsl_root_fsolver_alloc($gsl_root_fsolver_bisection);
$self->{fdfsolver} = gsl_root_fdfsolver_alloc($gsl_root_fdfsolver_newton);
}
sub teardown : Test(teardown) {
my $self = shift;
}
sub GSL_FDFSOLVER_BASIC : Tests {
my $self = shift;
my $solver = $self->{fdfsolver};
ok_status(
gsl_root_fdfsolver_set(
$solver,
{
f => sub { my $x = shift; $x**3 ; },
df => sub { my $x = shift; 3 * $x**2 ; },
fdf => sub {
my $x = shift;
return $x**3, 3 * $x**2;
}
},
5
) );
my ( $status, $root );
for ( 1 .. 20 ) {
$status = gsl_root_fdfsolver_iterate( $solver );
$root = gsl_root_fdfsolver_root( $solver );
}
ok_status( $status );
ok_similar( [$root], [0], 'gsl_root_fdfsolver_root', 0.1 );
}
sub GSL_ROOTS_SET : Tests {
my $self = shift;
my $solver = $self->{solver};
ok_status(gsl_root_fsolver_set($solver,
sub { my $x=shift; ($x-3.2)**3 },
0, 5
));
ok_similar( [$solver->{root} ], [2.5], 'bisection starts of with midpoint as initial guess' );
}
sub GSL_ROOT_ITERATE : Tests {
my $self = shift;
my $solver = gsl_root_fsolver_alloc($gsl_root_fsolver_brent);
ok_status(gsl_root_fsolver_set($solver,
sub { my $x=shift; ($x-3.2)**3 },
0, 5
));
my ($status, $root);
for (1..20) {
$status = gsl_root_fsolver_iterate($solver);
$root = gsl_root_fsolver_root($solver);
my $x_lo = gsl_root_fsolver_x_lower($solver);
my $x_hi = gsl_root_fsolver_x_upper($solver);
$status = gsl_root_test_interval($x_lo, $x_hi, 3.1, 3.3);
}
ok_status($status);
ok_similar([$root], [3.2], 'gsl_root_fsolver_root', 0.1);
}
sub SOlVER_TYPES : Tests {
cmp_ok( $gsl_root_fsolver_bisection->{name} ,'eq','bisection' );
cmp_ok( $gsl_root_fsolver_brent->{name} ,'eq','brent' );
cmp_ok( $gsl_root_fsolver_falsepos->{name} ,'eq','falsepos' );
cmp_ok( $gsl_root_fdfsolver_newton->{name} ,'eq','newton' );
cmp_ok( $gsl_root_fdfsolver_secant->{name} ,'eq','secant' );
cmp_ok( $gsl_root_fdfsolver_steffenson->{name},'eq','steffenson' );
}
sub GSL_ROOTFSOLVER_NAME : Tests {
my $self = shift;
cmp_ok( gsl_root_fsolver_name($self->{solver}) ,'eq','bisection' );
}
sub GSL_FDFSOLVER_NAME : Tests {
my $self = shift;
cmp_ok( gsl_root_fdfsolver_name($self->{fdfsolver}) ,'eq','newton' );
}
Test::Class->runtests;
|
