t/Sum.t

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