1 files changed, 382 insertions, 0 deletions
diff --git a/gsl-1.9/statistics/test_float_source.c b/gsl-1.9/statistics/test_float_source.c
new file mode 100644
index 0000000..7b29dfa
--- /dev/null
+++ b/gsl-1.9/statistics/test_float_source.c
@@ -0,0 +1,382 @@
+/* statistics/test_float_source.c
+ * 
+ * Copyright (C) 1996, 1997, 1998, 1999, 2000 Jim Davies, Brian Gough
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or (at
+ * your option) any later version.
+ * 
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+ */
+
+void FUNCTION (test, func) (const size_t stridea, const size_t strideb);
+
+void
+FUNCTION (test, func) (const size_t stridea, const size_t strideb)
+{
+  /* sample sets of doubles */
+  size_t i;
+  const size_t na = 14, nb = 14;
+
+  const double rawa[] =
+  {.0421, .0941, .1064, .0242, .1331,
+   .0773, .0243, .0815, .1186, .0356,
+   .0728, .0999, .0614, .0479};
+
+  const double rawb[] =
+  {.1081, .0986, .1566, .1961, .1125,
+   .1942, .1079, .1021, .1583, .1673,
+   .1675, .1856, .1688, .1512};
+
+  const double raww[] = 
+  {.0000, .0000, .0000, 3.000, .0000,
+   1.000, 1.000, 1.000, 0.000, .5000,
+   7.000, 5.000, 4.000, 0.123};
+
+  BASE * sorted ;
+
+  BASE * groupa = (BASE *) malloc (stridea * na * sizeof(BASE));
+  BASE * groupb = (BASE *) malloc (strideb * nb * sizeof(BASE));
+  BASE * w = (BASE *) malloc (strideb * na * sizeof(BASE));
+
+#ifdef BASE_FLOAT
+  double rel = 1e-6;
+#else
+  double rel = 1e-10;
+#endif
+
+  for (i = 0 ; i < na ; i++)
+    groupa[i * stridea] = (BASE) rawa[i] ;
+
+  for (i = 0 ; i < na ; i++)
+    w[i * strideb] = (BASE) raww[i] ;
+
+  for (i = 0 ; i < nb ; i++)
+    groupb[i * strideb] = (BASE) rawb[i] ;
+
+
+  {
+    double mean = FUNCTION(gsl_stats,mean) (groupa, stridea, na);
+    double expected = 0.0728;
+    gsl_test_rel (mean, expected, rel, NAME(gsl_stats) "_mean");
+  }
+
+  {
+    double mean = FUNCTION(gsl_stats,mean) (groupa, stridea, na);
+    double var = FUNCTION(gsl_stats,variance_with_fixed_mean) (groupa, stridea, na, mean);
+    double expected = 0.00113837428571429;
+    gsl_test_rel (var, expected, rel, NAME(gsl_stats) "_variance_with_fixed_mean");
+  }
+
+
+  {
+    double mean = FUNCTION(gsl_stats,mean) (groupa, stridea, na);
+    double var = FUNCTION(gsl_stats,sd_with_fixed_mean) (groupa, stridea, na, mean);
+    double expected = 0.0337398026922845;
+    gsl_test_rel (var, expected, rel, NAME(gsl_stats) "_sd_with_fixed_mean");
+  }
+
+
+  {
+    double var = FUNCTION(gsl_stats,variance) (groupb, strideb, nb);
+    double expected = 0.00124956615384615;
+    gsl_test_rel (var, expected, rel, NAME(gsl_stats) "_variance");
+  }
+
+  {
+    double sd = FUNCTION(gsl_stats,sd) (groupa, stridea, na);
+    double expected = 0.0350134479659107;
+    gsl_test_rel (sd, expected, rel, NAME(gsl_stats) "_sd");
+  }
+
+  {
+    double absdev = FUNCTION(gsl_stats,absdev) (groupa, stridea, na);
+    double expected = 0.0287571428571429;
+    gsl_test_rel (absdev, expected, rel, NAME(gsl_stats) "_absdev");
+  }
+
+  {
+    double skew = FUNCTION(gsl_stats,skew) (groupa, stridea, na);
+    double expected = 0.0954642051479004;
+    gsl_test_rel (skew, expected, rel, NAME(gsl_stats) "_skew");
+  }
+
+  {
+    double kurt = FUNCTION(gsl_stats,kurtosis) (groupa, stridea, na);
+    double expected = -1.38583851548909 ;
+    gsl_test_rel (kurt, expected, rel, NAME(gsl_stats) "_kurtosis");
+  }
+
+  {
+    double wmean = FUNCTION(gsl_stats,wmean) (w, strideb, groupa, stridea, na);
+    double expected = 0.0678111523670601;
+    gsl_test_rel (wmean, expected, rel, NAME(gsl_stats) "_wmean");
+  }
+
+  {
+    double wmean = FUNCTION(gsl_stats,wmean) (w, strideb, groupa, stridea, na);
+    double wvar = FUNCTION(gsl_stats,wvariance_with_fixed_mean) (w, strideb, groupa, stridea, na, wmean);
+    double expected = 0.000615793060878654;
+    gsl_test_rel (wvar, expected, rel, NAME(gsl_stats) "_wvariance_with_fixed_mean");
+  }
+
+  {
+    double est_wvar = FUNCTION(gsl_stats,wvariance) (w, strideb, groupa, stridea, na);
+    double expected = 0.000769562962860317;
+    gsl_test_rel (est_wvar, expected, rel, NAME(gsl_stats) "_wvariance");
+  }
+
+  {
+    double wsd = FUNCTION(gsl_stats,wsd) (w, strideb, groupa, stridea, na);
+    double expected = 0.0277409978706664;
+    gsl_test_rel (wsd, expected, rel, NAME(gsl_stats) "_wsd");
+  }
+
+  {
+    double wabsdev = FUNCTION(gsl_stats,wabsdev) (w, strideb, groupa, stridea, na);
+    double expected = 0.0193205027504008;
+    gsl_test_rel (wabsdev, expected, rel, NAME(gsl_stats) "_wabsdev");
+  }
+
+  {
+    double wskew = FUNCTION(gsl_stats,wskew) (w, strideb, groupa, stridea, na);
+    double expected = -0.373631000307076;
+    gsl_test_rel (wskew, expected, rel, NAME(gsl_stats) "_wskew");
+  }
+
+  {
+    double wkurt = FUNCTION(gsl_stats,wkurtosis) (w, strideb, groupa, stridea, na);
+    double expected = -1.48114233353963;
+    gsl_test_rel (wkurt, expected, rel, NAME(gsl_stats) "_wkurtosis");
+  }
+
+  {
+    double c = FUNCTION(gsl_stats,covariance) (groupa, stridea, groupb, strideb, nb);
+    double expected = -0.000139021538461539;
+    gsl_test_rel (c, expected, rel, NAME(gsl_stats) "_covariance");
+  }
+
+
+  {
+    double pv = FUNCTION(gsl_stats,pvariance) (groupa, stridea, na, groupb, strideb, nb);
+    double expected = 0.00123775384615385;
+    gsl_test_rel (pv, expected, rel, NAME(gsl_stats) "_pvariance");
+  }
+
+  {
+    double t = FUNCTION(gsl_stats,ttest) (groupa, stridea, na, groupb, strideb, nb);
+    double expected = -5.67026326985851;
+    gsl_test_rel (t, expected, rel, NAME(gsl_stats) "_ttest");
+  }
+
+  {
+    BASE expected = (BASE)0.1331;
+    gsl_test  (FUNCTION(gsl_stats,max) (groupa, stridea, na) != expected,
+               NAME(gsl_stats) "_max (" OUT_FORMAT " observed vs " OUT_FORMAT " expected)", 
+               FUNCTION(gsl_stats,max) (groupa, stridea, na), expected);
+  }
+
+  {
+    BASE min = FUNCTION(gsl_stats,min) (groupa, stridea, na);
+    BASE expected = (BASE)0.0242;
+    gsl_test (min != expected,
+              NAME(gsl_stats) "_min (" OUT_FORMAT " observed vs " OUT_FORMAT " expected)", 
+              min, expected);
+  }
+
+  {
+    BASE min, max;
+    BASE expected_max = (BASE)0.1331;
+    BASE expected_min = (BASE)0.0242;
+    
+    FUNCTION(gsl_stats,minmax) (&min, &max, groupa, stridea, na);
+ 
+    gsl_test  (max != expected_max,
+               NAME(gsl_stats) "_minmax max (" OUT_FORMAT " observed vs " OUT_FORMAT " expected)", 
+               max, expected_max);
+    gsl_test  (min != expected_min,
+               NAME(gsl_stats) "_minmax min (" OUT_FORMAT " observed vs " OUT_FORMAT " expected)", 
+               min, expected_min);
+  }
+
+  {
+    int max_index = FUNCTION(gsl_stats,max_index) (groupa, stridea, na);
+    int expected = 4;
+    gsl_test (max_index != expected,
+              NAME(gsl_stats) "_max_index (%d observed vs %d expected)",
+              max_index, expected);
+  }
+
+  {
+    int min_index = FUNCTION(gsl_stats,min_index) (groupa, stridea, na);
+    int expected = 3;
+    gsl_test (min_index != expected,
+              NAME(gsl_stats) "_min_index (%d observed vs %d expected)",
+              min_index, expected);
+  }
+
+  {
+    size_t min_index, max_index;
+    size_t expected_max_index = 4;
+    size_t expected_min_index = 3;
+
+    FUNCTION(gsl_stats,minmax_index) (&min_index, &max_index, groupa, stridea, na);
+
+    gsl_test  (max_index != expected_max_index,
+               NAME(gsl_stats) "_minmax_index max (%u observed vs %u expected)", 
+               max_index, expected_max_index);
+    gsl_test  (min_index != expected_min_index,
+               NAME(gsl_stats) "_minmax_index min (%u observed vs %u expected)", 
+               min_index, expected_min_index);
+  }
+
+
+  sorted = (BASE *) malloc(stridea * na * sizeof(BASE)) ;
+  
+  for (i = 0 ; i < na ; i++)
+    sorted[stridea * i] = groupa[stridea * i] ;
+  
+  TYPE(gsl_sort)(sorted, stridea, na) ;
+
+  {
+    double median = FUNCTION(gsl_stats,median_from_sorted_data)(sorted, stridea, na) ;
+    double expected = 0.07505;
+    gsl_test_rel  (median,expected, rel,
+                   NAME(gsl_stats) "_median_from_sorted_data (even)");
+  }
+
+  {
+    double median = FUNCTION(gsl_stats,median_from_sorted_data)(sorted, stridea, na - 1) ;
+    double expected = 0.0728;
+    gsl_test_rel  (median,expected, rel,
+                   NAME(gsl_stats) "_median_from_sorted_data");
+  }
+
+
+  {
+    double zeroth = FUNCTION(gsl_stats,quantile_from_sorted_data)(sorted, stridea, na, 0.0) ;
+    double expected = 0.0242;
+    gsl_test_rel  (zeroth,expected, rel,
+                   NAME(gsl_stats) "_quantile_from_sorted_data (0)");
+  }
+
+  {
+    double top = FUNCTION(gsl_stats,quantile_from_sorted_data)(sorted, stridea, na, 1.0) ;
+    double expected = 0.1331;
+    gsl_test_rel  (top,expected, rel,
+                   NAME(gsl_stats) "_quantile_from_sorted_data (100)");
+  }
+
+  {
+    double median = FUNCTION(gsl_stats,quantile_from_sorted_data)(sorted, stridea, na, 0.5) ;
+    double expected = 0.07505;
+    gsl_test_rel  (median,expected, rel,
+                   NAME(gsl_stats) "_quantile_from_sorted_data (50even)");
+  }
+
+  {
+    double median = FUNCTION(gsl_stats,quantile_from_sorted_data)(sorted, stridea, na - 1, 0.5);
+    double expected = 0.0728;
+    gsl_test_rel  (median,expected, rel,
+                   NAME(gsl_stats) "_quantile_from_sorted_data (50odd)");
+
+  }
+
+  /* Test for IEEE handling - set third element to NaN */
+
+  groupa [3*stridea] = GSL_NAN;
+
+  {
+    BASE max = FUNCTION(gsl_stats,max) (groupa, stridea, na);
+    BASE expected = GSL_NAN;
+    gsl_test  (!isnan(max),
+               NAME(gsl_stats) "_max NaN (" OUT_FORMAT " observed vs " OUT_FORMAT " expected)", 
+               max, expected);
+  }
+
+  {
+    BASE min = FUNCTION(gsl_stats,min) (groupa, stridea, na);
+    BASE expected = GSL_NAN;
+    gsl_test (!isnan(min),
+              NAME(gsl_stats) "_min NaN (" OUT_FORMAT " observed vs " OUT_FORMAT " expected)", 
+              min, expected);
+  }
+
+  {
+    BASE min, max;
+    BASE expected_max = GSL_NAN;
+    BASE expected_min = GSL_NAN;
+    
+    FUNCTION(gsl_stats,minmax) (&min, &max, groupa, stridea, na);
+ 
+    gsl_test  (!isnan(max),
+               NAME(gsl_stats) "_minmax max NaN (" OUT_FORMAT " observed vs " OUT_FORMAT " expected)", 
+               max, expected_max);
+    gsl_test  (!isnan(min),
+               NAME(gsl_stats) "_minmax min NaN (" OUT_FORMAT " observed vs " OUT_FORMAT " expected)", 
+               min, expected_min);
+  }
+
+#ifdef FAST
+  {
+    BASE min, max;
+    BASE expected_max = GSL_NAN;
+    BASE expected_min = GSL_NAN;
+    
+    FUNCTION(gsl_stats,minmax) (&min, &max, groupa, stridea, na-1);
+ 
+    gsl_test  (!isnan(max),
+               NAME(gsl_stats) "_minmax(-1) max NaN (" OUT_FORMAT " observed vs " OUT_FORMAT " expected)", 
+               max, expected_max);
+    gsl_test  (!isnan(min),
+               NAME(gsl_stats) "_minmax(-1) min NaN (" OUT_FORMAT " observed vs " OUT_FORMAT " expected)", 
+               min, expected_min);
+  }
+#endif
+
+
+  {
+    int max_index = FUNCTION(gsl_stats,max_index) (groupa, stridea, na);
+    int expected = 3;
+    gsl_test (max_index != expected,
+              NAME(gsl_stats) "_max_index NaN (%d observed vs %d expected)",
+              max_index, expected);
+  }
+
+  {
+    int min_index = FUNCTION(gsl_stats,min_index) (groupa, stridea, na);
+    int expected = 3;
+    gsl_test (min_index != expected,
+              NAME(gsl_stats) "_min_index NaN (%d observed vs %d expected)",
+              min_index, expected);
+  }
+
+  {
+    size_t min_index, max_index;
+    size_t expected_max_index = 3;
+    size_t expected_min_index = 3;
+
+    FUNCTION(gsl_stats,minmax_index) (&min_index, &max_index, groupa, stridea, na);
+
+    gsl_test  (max_index != expected_max_index,
+               NAME(gsl_stats) "_minmax_index max NaN (%u observed vs %u expected)", 
+               max_index, expected_max_index);
+    gsl_test  (min_index != expected_min_index,
+               NAME(gsl_stats) "_minmax_index min NaN (%u observed vs %u expected)", 
+               min_index, expected_min_index);
+  }
+
+  free (sorted);
+  free (groupa);
+  free (groupb);
+  free (w);
+
+}