t/Fit.t

   1 package Math::GSL::Fit::Test;
   2 use Math::GSL::Test qw/:all/;
   3 use base q{Test::Class};
   4 use Test::More;
   5 use Test::Exception;
   6 use Math::GSL::Fit qw/:all/;
   7 use Math::GSL qw/:all/;
   8 use Math::GSL::Errno qw/:all/;
   9 use Data::Dumper;
  10 use strict;
  11
  12 sub make_fixture : Test(setup) {
  13 }
  14
  15 sub teardown : Test(teardown) {
  16 }
  17
  18 sub FIT_LINEAR_DIES : Tests {
  19  dies_ok( sub { gsl_fit_linear(0,0,0,0) } );
  20 }
  21
  22 sub GSL_FIT_LINEAR : Tests {
  23  my @norris_x = (0.2, 337.4, 118.2, 884.6, 10.1, 226.5, 666.3, 996.3,
  24                         448.6, 777.0, 558.2, 0.4, 0.6, 775.5, 666.9, 338.0,
  25                         447.5, 11.6, 556.0, 228.1, 995.8, 887.6, 120.2, 0.3,
  26                         0.3, 556.8, 339.1, 887.2, 999.0, 779.0, 11.1, 118.3,
  27                         229.2, 669.1, 448.9, 0.5 ) ;
  28     my @norris_y = ( 0.1, 338.8, 118.1, 888.0, 9.2, 228.1, 668.5, 998.5,
  29                         449.1, 778.9, 559.2, 0.3, 0.1, 778.1, 668.8, 339.3,
  30                         448.9, 10.8, 557.7, 228.3, 998.0, 888.8, 119.6, 0.3,
  31                         0.6, 557.6, 339.3, 888.0, 998.5, 778.9, 10.2, 117.6,
  32                         228.9, 668.4, 449.2, 0.2);
  33     my $xstride = 2;
  34     my $wstride = 3;
  35     my $ystride = 5;
  36     my ($x, $w, $y);
  37     for my $i (0 .. 175)
  38     {
  39         $x->[$i] = 0;
  40         $w->[$i] = 0;
  41         $y->[$i] = 0;
  42     }
  43
  44     for my $i (0 .. 35)
  45     {
  46         $x->[$i*$xstride] = $norris_x[$i];
  47         $w->[$i*$wstride] = 1.0;
  48         $y->[$i*$ystride] = $norris_y[$i];
  49     }
  50     my ($status, @results) = gsl_fit_linear($x, $xstride, $y, $ystride, 36);
  51 # this way of writing the arrays works but it complains
  52 # about a lot of unitialized entries even with the stride correctly set,
  53 # is there any way to bypass this without having to initialize every element of the array like I do?
  54
  55     ok_status( $status);
  56     ok(is_similar_relative($results[0], -0.262323073774029, 10**-10));
  57     ok(is_similar_relative($results[1], 1.00211681802045, 1e-10));
  58     ok(is_similar_relative($results[2], 0.232818234301152**2.0, 1e-10));
  59     ok(is_similar_relative($results[3], -7.74327536339570e-05, 1e-10));
  60     ok(is_similar_relative($results[4], 0.429796848199937E-03**2, 1e-10));
  61     ok(is_similar_relative($results[5], 26.6173985294224, 1e-10));
  62 }
  63 sub GSL_FIT_WLINEAR : Tests {
  64    my @norris_x = (0.2, 337.4, 118.2, 884.6, 10.1, 226.5, 666.3, 996.3,
  65                         448.6, 777.0, 558.2, 0.4, 0.6, 775.5, 666.9, 338.0,
  66                         447.5, 11.6, 556.0, 228.1, 995.8, 887.6, 120.2, 0.3,
  67                         0.3, 556.8, 339.1, 887.2, 999.0, 779.0, 11.1, 118.3,
  68                         229.2, 669.1, 448.9, 0.5 ) ;
  69     my @norris_y = ( 0.1, 338.8, 118.1, 888.0, 9.2, 228.1, 668.5, 998.5,
  70                         449.1, 778.9, 559.2, 0.3, 0.1, 778.1, 668.8, 339.3,
  71                         448.9, 10.8, 557.7, 228.3, 998.0, 888.8, 119.6, 0.3,
  72                         0.6, 557.6, 339.3, 888.0, 998.5, 778.9, 10.2, 117.6,
  73                         228.9, 668.4, 449.2, 0.2);
  74     my $xstride = 2;
  75     my $wstride = 3;
  76     my $ystride = 5;
  77     my ($x, $w, $y);
  78     for my $i (0 .. 175)
  79     {
  80         $x->[$i] = 0;
  81         $w->[$i] = 0;
  82         $y->[$i] = 0;
  83     }
  84
  85     for my $i (0 .. 35)
  86     {
  87         $x->[$i*$xstride] = $norris_x[$i];
  88         $w->[$i*$wstride] = 1.0;
  89         $y->[$i*$ystride] = $norris_y[$i];
  90     }
  91
  92     my $expected_c0 = -0.262323073774029;
  93     my $expected_c1 =  1.00211681802045;
  94     my $expected_cov00 = 6.92384428759429e-02;  # computed from octave
  95     my $expected_cov01 = -9.89095016390515e-05; # computed from octave
  96     my $expected_cov11 = 2.35960747164148e-07;  # computed from octave
  97     my $expected_sumsq = 26.6173985294224;
  98
  99     my @got = gsl_fit_wlinear ($x, $xstride, $w, $wstride, $y, $ystride, 36);
 100
 101     ok_status($got[0]);
 102     ok(is_similar_relative($got[1], $expected_c0, 1e-10), "norris gsl_fit_wlinear c0");
 103     ok(is_similar_relative($got[2], $expected_c1, 1e-10), "norris gsl_fit_wlinear c1");
 104     ok(is_similar_relative($got[3], $expected_cov00, 1e-10), "norris gsl_fit_wlinear cov00");
 105     ok(is_similar_relative($got[4], $expected_cov01, 1e-10), "norris gsl_fit_wlinear cov01");
 106     ok(is_similar_relative($got[5], $expected_cov11, 1e-10), "norris gsl_fit_wlinear cov11");
 107     ok(is_similar_relative($got[6], $expected_sumsq, 1e-10), "norris gsl_fit_wlinear sumsq");
 108 }
 109
 110 sub GSL_FIT_MUL : Tests {
 111     my @noint1_x = ( 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70 );
 112     my @noint1_y = ( 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140);
 113
 114     my $xstride = 2;
 115     my $wstride = 3;
 116     my $ystride = 5;
 117     my ($x, $w, $y);
 118     for my $i (0 .. 60)
 119     {
 120         $x->[$i] = 0;
 121         $w->[$i] = 0;
 122         $y->[$i] = 0;
 123     }
 124
 125     for my $i (0 .. 10)
 126     {
 127       $x->[$i*$xstride] = $noint1_x[$i];
 128       $w->[$i*$wstride] = 1.0;
 129       $y->[$i*$ystride] = $noint1_y[$i];
 130     }
 131
 132     my $expected_c1 = 2.07438016528926;
 133     my $expected_cov11 = (0.165289256198347*(10**-1))**2.0;
 134     my $expected_sumsq = 127.272727272727;
 135
 136     my @got = gsl_fit_mul ($x, $xstride, $y, $ystride, 11);
 137
 138     ok_status($got[0]);
 139     ok(is_similar_relative($got[1], $expected_c1, 1e-10), "noint1 gsl_fit_mul c1");
 140     ok(is_similar_relative($got[2], $expected_cov11, 1e-10), "noint1 gsl_fit_mul cov11");
 141     ok(is_similar_relative($got[3], $expected_sumsq, 1e-10), "noint1 gsl_fit_mul sumsq");
 142 }
 143
 144 sub GSL_FIT_WMUL : Tests {
 145     my @noint1_x = ( 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70 );
 146     my @noint1_y = ( 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140);
 147
 148     my $xstride = 2;
 149     my $wstride = 3;
 150     my $ystride = 5;
 151     my ($x, $w, $y);
 152     for my $i (0 .. 60)
 153     {
 154         $x->[$i] = 0;
 155         $w->[$i] = 0;
 156         $y->[$i] = 0;
 157     }
 158
 159     for my $i (0 .. 10)
 160     {
 161       $x->[$i*$xstride] = $noint1_x[$i];
 162       $w->[$i*$wstride] = 1.0;
 163       $y->[$i*$ystride] = $noint1_y[$i];
 164     }
 165
 166     my $expected_c1 = 2.07438016528926;
 167     my $expected_cov11 = 2.14661371686165e-05; # computed from octave
 168     my $expected_sumsq = 127.272727272727;
 169
 170     my @got = gsl_fit_wmul ($x, $xstride, $w, $wstride, $y, $ystride, 11);
 171
 172     ok_status($got[0]);
 173     ok(is_similar_relative($got[1], $expected_c1, 1e-10), "noint1 gsl_fit_wmul c1");
 174     ok(is_similar_relative($got[2], $expected_cov11, 1e-10), "noint1 gsl_fit_wmul cov11");
 175     ok(is_similar_relative($got[3], $expected_sumsq, 1e-10), "noint1 gsl_fit_wmul sumsq");
 176 }
 177 Test::Class->runtests;