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
102
103
104
105
106
107
108
109
110
111
|
package Math::GSL::Sum::Test;
use base q{Test::Class};
use Test::More tests => 14;
use Math::GSL::Sum qw/:all/;
use Math::GSL::Test qw/:all/;
use Math::GSL::Errno qw/:all/;
use Math::GSL::Const qw/:all/;
use Math::GSL::Machine qw/:all/;
use Data::Dumper;
use strict;
BEGIN { gsl_set_error_handler_off() }
sub make_fixture : Test(setup) {
}
sub teardown : Test(teardown) {
}
sub LEVIN_U_ALLOC_FREE : Tests {
my $w = gsl_sum_levin_u_alloc(5);
isa_ok($w, 'Math::GSL::Sum');
gsl_sum_levin_u_free($w);
ok(!$@, 'gsl_histogram_free');
}
sub LEVIN_UTRUNC_ALLOC_FREE : Tests {
my $w = gsl_sum_levin_utrunc_alloc(5);
isa_ok($w, 'Math::GSL::Sum');
gsl_sum_levin_utrunc_free($w);
ok(!$@, 'gsl_histogram_free');
}
sub ACCEL : Tests {
my $t;
my $np1;
my $zeta_2 = $M_PI * $M_PI / 6.0;
for my $n (0..49)
{
$np1 = $n + 1.0;
$t->[$n] = 1.0 / ($np1 * $np1);
}
my $w = gsl_sum_levin_utrunc_alloc (50);
my @got = gsl_sum_levin_utrunc_accel ($t, 50, $w);
ok_status($got[0], $GSL_SUCCESS);
ok(is_similar_relative($got[1], $zeta_2, 1e-8), "trunc result, zeta(2)");
# No need to check precision for truncated result since this is not a meaningful number
gsl_sum_levin_utrunc_free ($w);
$w = gsl_sum_levin_u_alloc (50);
@got = gsl_sum_levin_u_accel ($t, 50, $w);
ok_status($got[0], $GSL_SUCCESS);
ok(is_similar_relative($got[1], $zeta_2, 1e-8), "full result, zeta(2)");
my $sd_est = -(log($got[2]/abs($got[1]))/log(10));
my $sd_actual = -(log($GSL_DBL_EPSILON + abs(($got[1] - $zeta_2)/$zeta_2))/log(10));
# Allow one digit of slop
local $TODO = "The error test from GSL fails here";
ok ($sd_est > $sd_actual + 1.0, "full significant digits, zeta(2) ($sd_est vs $sd_actual)");
gsl_sum_levin_u_free ($w);
}
sub ACCEL2 : Tests {
my $t;
my $np1;
my $x = 10.0;
my $y = exp($x);
$t->[0] = 1.0;
for my $n (1..49)
{
$t->[$n] = $t->[$n - 1] * ($x / $n);
}
my $w = gsl_sum_levin_utrunc_alloc (50);
my @got = gsl_sum_levin_utrunc_accel ($t, 50, $w);
ok_status($got[0], $GSL_SUCCESS);
ok(is_similar_relative($got[1], $y, 1e-8), "trunc result, exp(10)");
# No need to check precision for truncated result since this is not a meaningful number
gsl_sum_levin_utrunc_free ($w);
$w = gsl_sum_levin_u_alloc (50);
@got = gsl_sum_levin_u_accel ($t, 50, $w);
ok_status($got[0], $GSL_SUCCESS);
ok(is_similar_relative($got[1], $y, 1e-8), "full result, exp(10)");
my $sd_est = -(log($got[2]/abs($got[1]))/log(10));
my $sd_actual = -(log($GSL_DBL_EPSILON + abs(($got[1] - $y)/$y))/log(10));
# Allow one digit of slop
local $TODO = "The error test from GSL fails here";
ok ($sd_est > $sd_actual + 1.0, "full significant digits, exp(10) ($sd_est vs $sd_actual)");
gsl_sum_levin_u_free ($w);
}
Test::Class->runtests;
|
