t/Sum.t

   1 package Math::GSL::Sum::Test;
   2 use base q{Test::Class};
   3 use Test::More tests => 14;
   4 use Math::GSL::Sum     qw/:all/;
   5 use Math::GSL::Test    qw/:all/;
   6 use Math::GSL::Errno   qw/:all/;
   7 use Math::GSL::Const   qw/:all/;
   8 use Math::GSL::Machine qw/:all/;
   9 use Data::Dumper;
  10 use strict;
  11
  12
  13 sub make_fixture : Test(setup) {
  14 }
  15
  16 sub teardown : Test(teardown) {
  17 }
  18
  19 sub LEVIN_U_ALLOC_FREE : Tests {
  20   my $w = gsl_sum_levin_u_alloc(5);
  21   isa_ok($w, 'Math::GSL::Sum');
  22   gsl_sum_levin_u_free($w);
  23   ok(!$@, 'gsl_histogram_free');
  24 }
  25
  26 sub LEVIN_UTRUNC_ALLOC_FREE : Tests {
  27   my $w = gsl_sum_levin_utrunc_alloc(5);
  28   isa_ok($w, 'Math::GSL::Sum');
  29   gsl_sum_levin_utrunc_free($w);
  30   ok(!$@, 'gsl_histogram_free');
  31 }
  32
  33 sub ACCEL : Tests  {
  34    my $t;
  35    my $np1;
  36
  37    my $zeta_2 = $M_PI * $M_PI / 6.0;
  38
  39     for my $n (0..49)
  40       {
  41         $np1 = $n + 1.0;
  42         $t->[$n] = 1.0 / ($np1 * $np1);
  43       }
  44
  45   my $w = gsl_sum_levin_utrunc_alloc (50);
  46
  47   my @got = gsl_sum_levin_utrunc_accel ($t, 50, $w);
  48   ok_status($got[0], $GSL_SUCCESS);
  49   ok(is_similar_relative($got[1], $zeta_2, 1e-8), "trunc result, zeta(2)");
  50
  51   # No need to check precision for truncated result since this is not a meaningful number
  52
  53   gsl_sum_levin_utrunc_free ($w);
  54
  55
  56   $w = gsl_sum_levin_u_alloc (50);
  57
  58   @got = gsl_sum_levin_u_accel ($t, 50, $w);
  59   ok_status($got[0], $GSL_SUCCESS);
  60   ok(is_similar_relative($got[1], $zeta_2, 1e-8), "full result, zeta(2)");
  61
  62   my $sd_est = -(log($got[2]/abs($got[1]))/log(10));
  63   my $sd_actual = -(log($GSL_DBL_EPSILON + abs(($got[1] - $zeta_2)/$zeta_2))/log(10));
  64
  65   # Allow one digit of slop
  66
  67   local $TODO = "The error test from GSL fails here";
  68   ok ($sd_est > $sd_actual + 1.0, "full significant digits, zeta(2) ($sd_est vs $sd_actual)");
  69
  70   gsl_sum_levin_u_free ($w);
  71 }
  72
  73 sub ACCEL2 : Tests  {
  74    my $t;
  75    my $np1;
  76    my $x = 10.0;
  77    my $y = exp($x);
  78    $t->[0] = 1.0;
  79     for my $n (1..49)
  80     {
  81        $t->[$n] = $t->[$n - 1] * ($x / $n);
  82     }
  83   my $w = gsl_sum_levin_utrunc_alloc (50);
  84
  85   my @got = gsl_sum_levin_utrunc_accel ($t, 50, $w);
  86   ok_status($got[0], $GSL_SUCCESS);
  87   ok(is_similar_relative($got[1], $y, 1e-8), "trunc result, exp(10)");
  88
  89   # No need to check precision for truncated result since this is not a meaningful number
  90
  91   gsl_sum_levin_utrunc_free ($w);
  92
  93
  94   $w = gsl_sum_levin_u_alloc (50);
  95
  96   @got = gsl_sum_levin_u_accel ($t, 50, $w);
  97   ok_status($got[0], $GSL_SUCCESS);
  98   ok(is_similar_relative($got[1], $y, 1e-8), "full result, exp(10)");
  99
 100   my $sd_est = -(log($got[2]/abs($got[1]))/log(10));
 101   my $sd_actual = -(log($GSL_DBL_EPSILON + abs(($got[1] - $y)/$y))/log(10));
 102
 103   # Allow one digit of slop
 104   local $TODO = "The error test from GSL fails here";
 105   ok ($sd_est > $sd_actual + 1.0, "full significant digits, exp(10) ($sd_est vs $sd_actual)");
 106
 107   gsl_sum_levin_u_free ($w);
 108 }
 109
 110 Test::Class->runtests;