test.c

开放gsl矩阵运算

/* randist/test.c
 * 
 * Copyright (C) 1996, 1997, 1998, 1999, 2000 James Theiler, 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., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

#include <config.h>
#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_randist.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_test.h>
#include <gsl/gsl_ieee_utils.h>

#define N 100000
void testMoments (double (*f) (void), const char *name,
		   double a, double b, double p);
void testPDF (double (*f) (void), double (*pdf)(double), const char *name);
void testDiscretePDF (double (*f) (void), double (*pdf)(unsigned int), 
			const char *name);

void test_shuffle (void);
void test_choose (void);
double test_beta (void);
double test_beta_pdf (double x);
double test_bernoulli (void);
double test_bernoulli_pdf (unsigned int n);
double test_binomial (void);
double test_binomial_pdf (unsigned int n);
double test_binomial_large (void);
double test_binomial_large_pdf (unsigned int n);
double test_cauchy (void);
double test_cauchy_pdf (double x);
double test_chisq (void);
double test_chisq_pdf (double x);
double test_discrete1 (void);
double test_discrete1_pdf (unsigned int n);
double test_discrete2 (void);
double test_discrete2_pdf (unsigned int n);
double test_erlang (void);
double test_erlang_pdf (double x);
double test_exponential (void);
double test_exponential_pdf (double x);
double test_exppow0 (void);
double test_exppow0_pdf (double x);
double test_exppow1 (void);
double test_exppow1_pdf (double x);
double test_exppow1a (void);
double test_exppow1a_pdf (double x);
double test_exppow2 (void);
double test_exppow2_pdf (double x);
double test_exppow2a (void);
double test_exppow2a_pdf (double x);
double test_fdist (void);
double test_fdist_pdf (double x);
double test_flat (void);
double test_flat_pdf (double x);
double test_gamma (void);
double test_gamma_pdf (double x);
double test_gamma1 (void);
double test_gamma1_pdf (double x);
double test_gamma_int (void);
double test_gamma_int_pdf (double x);
double test_gamma_large (void);
double test_gamma_large_pdf (double x);
double test_gaussian (void);
double test_gaussian_pdf (double x);
double test_gaussian_ratio_method (void);
double test_gaussian_ratio_method_pdf (double x);
double test_gaussian_tail (void);
double test_gaussian_tail_pdf (double x);
double test_gaussian_tail1 (void);
double test_gaussian_tail1_pdf (double x);
double test_gaussian_tail2 (void);
double test_gaussian_tail2_pdf (double x);
double test_ugaussian (void);
double test_ugaussian_pdf (double x);
double test_ugaussian_ratio_method (void);
double test_ugaussian_ratio_method_pdf (double x);
double test_ugaussian_tail (void);
double test_ugaussian_tail_pdf (double x);
double test_bivariate_gaussian1 (void);
double test_bivariate_gaussian1_pdf (double x);
double test_bivariate_gaussian2 (void);
double test_bivariate_gaussian2_pdf (double x);
double test_bivariate_gaussian3 (void);
double test_bivariate_gaussian3_pdf (double x);
double test_bivariate_gaussian4 (void);
double test_bivariate_gaussian4_pdf (double x);
double test_gumbel1 (void);
double test_gumbel1_pdf (double x);
double test_gumbel2 (void);
double test_gumbel2_pdf (double x);
double test_geometric (void);
double test_geometric_pdf (unsigned int x);
double test_geometric1 (void);
double test_geometric1_pdf (unsigned int x);
double test_hypergeometric1 (void);
double test_hypergeometric1_pdf (unsigned int x);
double test_hypergeometric2 (void);
double test_hypergeometric2_pdf (unsigned int x);
double test_hypergeometric3 (void);
double test_hypergeometric3_pdf (unsigned int x);
double test_hypergeometric4 (void);
double test_hypergeometric4_pdf (unsigned int x);
double test_hypergeometric5 (void);
double test_hypergeometric5_pdf (unsigned int x);
double test_hypergeometric6 (void);
double test_hypergeometric6_pdf (unsigned int x);
double test_landau (void);
double test_landau_pdf (double x);
double test_levy1 (void);
double test_levy1_pdf (double x);
double test_levy2 (void);
double test_levy2_pdf (double x);
double test_levy1a (void);
double test_levy1a_pdf (double x);
double test_levy2a (void);
double test_levy2a_pdf (double x);
double test_levy_skew1 (void);
double test_levy_skew1_pdf (double x);
double test_levy_skew2 (void);
double test_levy_skew2_pdf (double x);
double test_levy_skew1a (void);
double test_levy_skew1a_pdf (double x);
double test_levy_skew2a (void);
double test_levy_skew2a_pdf (double x);
double test_levy_skew1b (void);
double test_levy_skew1b_pdf (double x);
double test_levy_skew2b (void);
double test_levy_skew2b_pdf (double x);
double test_logistic (void);
double test_logistic_pdf (double x);
double test_lognormal (void);
double test_lognormal_pdf (double x);
double test_logarithmic (void);
double test_logarithmic_pdf (unsigned int n);
double test_negative_binomial (void);
double test_negative_binomial_pdf (unsigned int n);
double test_pascal (void);
double test_pascal_pdf (unsigned int n);
double test_pareto (void);
double test_pareto_pdf (double x);
double test_poisson (void);
double test_poisson_pdf (unsigned int x);
double test_poisson_large (void);
double test_poisson_large_pdf (unsigned int x);
double test_dir2d (void);
double test_dir2d_pdf (double x);
double test_dir2d_trig_method (void);
double test_dir2d_trig_method_pdf (double x);
double test_dir3dxy (void);
double test_dir3dxy_pdf (double x);
double test_dir3dyz (void);
double test_dir3dyz_pdf (double x);
double test_dir3dzx (void);
double test_dir3dzx_pdf (double x);
double test_rayleigh (void);
double test_rayleigh_pdf (double x);
double test_rayleigh_tail (void);
double test_rayleigh_tail_pdf (double x);
double test_tdist1 (void);
double test_tdist1_pdf (double x);
double test_tdist2 (void);
double test_tdist2_pdf (double x);
double test_laplace (void);
double test_laplace_pdf (double x);
double test_weibull (void);
double test_weibull_pdf (double x);
double test_weibull1 (void);
double test_weibull1_pdf (double x);

gsl_rng *r_global;

int
main (void)
{
  gsl_ieee_env_setup ();

  gsl_rng_env_setup() ;
  r_global = gsl_rng_alloc (gsl_rng_default);

#define FUNC(x)  test_ ## x,                     "test gsl_ran_" #x
#define FUNC2(x) test_ ## x, test_ ## x ## _pdf, "test gsl_ran_" #x

  test_shuffle() ;
  test_choose() ;

  testMoments (FUNC (ugaussian), 0.0, 100.0, 0.5);
  testMoments (FUNC (ugaussian), -1.0, 1.0, 0.6826895);
  testMoments (FUNC (ugaussian), 3.0, 3.5, 0.0011172689);
  testMoments (FUNC (ugaussian_tail), 3.0, 3.5, 0.0011172689/0.0013498981);
  testMoments (FUNC (exponential), 0.0, 1.0, 1- exp(-0.5));
  testMoments (FUNC (cauchy), 0.0, 10000.0, 0.5);

  testMoments (FUNC (discrete1), -0.5, 0.5, 0.59 );
  testMoments (FUNC (discrete1), 0.5, 1.5, 0.40 );
  testMoments (FUNC (discrete1), 1.5, 3.5, 0.01 );

  testPDF (FUNC2(beta));
  testPDF (FUNC2(cauchy));
  testPDF (FUNC2(chisq));
  testPDF (FUNC2(erlang));
  testPDF (FUNC2(exponential));

  testPDF (FUNC2(exppow0));
  testPDF (FUNC2(exppow1));
  testPDF (FUNC2(exppow1a));
  testPDF (FUNC2(exppow2));
  testPDF (FUNC2(exppow2a));

  testPDF (FUNC2(fdist));
  testPDF (FUNC2(flat));
  testPDF (FUNC2(gamma));
  testPDF (FUNC2(gamma1));
  testPDF (FUNC2(gamma_int));
  testPDF (FUNC2(gamma_large));
  testPDF (FUNC2(gaussian));
  testPDF (FUNC2(gaussian_ratio_method));
  testPDF (FUNC2(ugaussian));
  testPDF (FUNC2(ugaussian_ratio_method));
  testPDF (FUNC2(gaussian_tail));
  testPDF (FUNC2(gaussian_tail1));
  testPDF (FUNC2(gaussian_tail2));
  testPDF (FUNC2(ugaussian_tail));
  
  testPDF (FUNC2(bivariate_gaussian1));
  testPDF (FUNC2(bivariate_gaussian2));
  testPDF (FUNC2(bivariate_gaussian3));
  testPDF (FUNC2(bivariate_gaussian4));

  testPDF (FUNC2(gumbel1));
  testPDF (FUNC2(gumbel2));
  testPDF (FUNC2(landau));
  testPDF (FUNC2(levy1));
  testPDF (FUNC2(levy2));
  testPDF (FUNC2(levy1a));
  testPDF (FUNC2(levy2a));
  testPDF (FUNC2(levy_skew1));
  testPDF (FUNC2(levy_skew2));
  testPDF (FUNC2(levy_skew1a));
  testPDF (FUNC2(levy_skew2a));
  testPDF (FUNC2(levy_skew1b));
  testPDF (FUNC2(levy_skew2b));
  testPDF (FUNC2(logistic));
  testPDF (FUNC2(lognormal));
  testPDF (FUNC2(pareto));
  testPDF (FUNC2(rayleigh));
  testPDF (FUNC2(rayleigh_tail));
  testPDF (FUNC2(tdist1));
  testPDF (FUNC2(tdist2));
  testPDF (FUNC2(laplace));
  testPDF (FUNC2(weibull));
  testPDF (FUNC2(weibull1));

  testPDF (FUNC2(dir2d));
  testPDF (FUNC2(dir2d_trig_method));
  testPDF (FUNC2(dir3dxy));
  testPDF (FUNC2(dir3dyz));
  testPDF (FUNC2(dir3dzx));

  testDiscretePDF (FUNC2(discrete1));
  testDiscretePDF (FUNC2(discrete2));
  testDiscretePDF (FUNC2(poisson));
  testDiscretePDF (FUNC2(poisson_large));
  testDiscretePDF (FUNC2(bernoulli));
  testDiscretePDF (FUNC2(binomial));
  testDiscretePDF (FUNC2(binomial_large));
  testDiscretePDF (FUNC2(geometric));
  testDiscretePDF (FUNC2(geometric1));
  testDiscretePDF (FUNC2(hypergeometric1));
  testDiscretePDF (FUNC2(hypergeometric2));
  testDiscretePDF (FUNC2(hypergeometric3));
  testDiscretePDF (FUNC2(hypergeometric4));
  testDiscretePDF (FUNC2(hypergeometric5));
  testDiscretePDF (FUNC2(hypergeometric6));
  testDiscretePDF (FUNC2(logarithmic));
  testDiscretePDF (FUNC2(negative_binomial));
  testDiscretePDF (FUNC2(pascal));

  exit (gsl_test_summary());
}

void
test_shuffle (void)
{
  double count[10][10] ;
  int x[10] = {0, 1, 2, 3, 4, 5, 6, 7, 8, 9} ;
  int i, j, status = 0;

  for (i = 0; i < 10; i++)
    {
      for (j = 0; j < 10; j++)
	{
	  count[i][j] = 0 ;
	}
    }

  for (i = 0 ; i < N; i++)
    {
      for (j = 0; j < 10; j++)
	x[j] = j ;

      gsl_ran_shuffle (r_global, x, 10, sizeof(int)) ;

      for (j = 0; j < 10; j++)
	count[x[j]][j] ++ ;
    }

  for (i = 0; i < 10; i++)
    {
      for (j = 0; j < 10; j++)
	{
	  double expected = N / 10.0 ;
	  double d = fabs(count[i][j] - expected);
	  double sigma = d / sqrt(expected) ;
	  if (sigma > 5 && d > 1)
	    {
	      status = 1 ;
	      gsl_test (status, 
			"gsl_ran_shuffle %d,%d (%g observed vs %g expected)", 
			i, j, count[i][j]/N, 0.1) ;
	    }
	}
    }
  
  gsl_test (status, "gsl_ran_shuffle on {0, 1, 2, 3, 4, 5, 6, 7, 8, 9}") ;

}

void
test_choose (void)
{
  double count[10] ;
  int x[10] = {0, 1, 2, 3, 4, 5, 6, 7, 8, 9} ;
  int y[3] = {0, 1, 2} ;
  int i, j, status = 0;

  for (i = 0; i < 10; i++)
    {
      count[i] = 0 ;
    }

  for (i = 0 ; i < N; i++)
    {
      for (j = 0; j < 10; j++)
	x[j] = j ;

      gsl_ran_choose (r_global, y, 3, x, 10, sizeof(int)) ;

      for (j = 0; j < 3; j++)
	count[y[j]]++ ;
    }

  for (i = 0; i < 10; i++)
    {
      double expected = 3.0 * N / 10.0 ;
      double d = fabs(count[i] - expected);
      double sigma = d / sqrt(expected) ;
      if (sigma > 5 && d > 1)
	{
	  status = 1 ;
	  gsl_test (status, 
		    "gsl_ran_choose %d (%g observed vs %g expected)", 
		    i, count[i]/N, 0.1) ;
	}
    }
  
  gsl_test (status, "gsl_ran_choose (3) on {0, 1, 2, 3, 4, 5, 6, 7, 8, 9}") ;

}




void
testMoments (double (*f) (void), const char *name,
	      double a, double b, double p)
{
  int i;
  double count = 0, expected, sigma;
  int status;

  for (i = 0; i < N; i++)
    {
      double r = f ();
      if (r < b && r > a)
	count++;
    }

  expected = p * N;
  sigma = fabs (count - expected) / sqrt (expected);

  status = (sigma > 3);

  gsl_test (status, "%s [%g,%g] (%g observed vs %g expected)",
	    name, a, b, count / N, p);
}

#define BINS 100

void
testPDF (double (*f) (void), double (*pdf)(double), const char *name)
{
  double count[BINS], p[BINS];
  double a = -5.0, b = +5.0 ;
  double dx = (b - a) / BINS ;
  int i,j,status = 0, status_i =0 ;

  for (i = 0; i < BINS; i++)
    count[i] = 0 ;

  for (i = 0; i < N; i++)
    {
      double r = f ();
      if (r < b && r > a)
	{ 
	  j =  (int)((r - a)/dx) ;
	  count[j]++;
	}
    }
  
  for (i = 0; i < BINS; i++)
    {
      /* Compute an approximation to the integral of p(x) from x to
         x+dx using Simpson's rule */

      double x = a + i * dx ;
#define STEPS 100
      double sum = 0 ;
      
      if (fabs(x) < 1e-10) /* hit the origin exactly */
	x = 0.0 ; 
      
      for (j = 1; j < STEPS; j++)
	sum += pdf(x + j * dx / STEPS) ;

      p[i] =  0.5 * (pdf(x) + 2*sum + pdf(x + dx - 1e-7)) * dx / STEPS ;
    }

  for (i = 0; i < BINS; i++)
    {
      double x = a + i * dx ;
      double d = fabs(count[i] - N*p[i]) ;
      if (p[i] != 0)
	{
	  double s = d / sqrt(N*p[i]) ;
	  status_i = (s > 5) && (d > 1) ;
	}
      else
	{
	  status_i = (count[i] != 0) ;
	}
      status |= status_i ;
      if (status_i) 
	gsl_test (status_i, "%s [%g,%g) (%g/%d=%g observed vs %g expected)", 
		  name, x, x+dx, count[i],N,count[i]/N, p[i]) ;
    }

  if (status == 0)
    gsl_test (status, "%s, sampling against pdf over range [%g,%g) ", 
	      name, a, b) ;
}

void
testDiscretePDF (double (*f) (void), double (*pdf)(unsigned int), const char *name)
{
  double count[BINS], p[BINS];
  unsigned int i ;
  int status = 0, status_i =0 ;

  for (i = 0; i < BINS; i++)
    count[i] = 0 ;

  for (i = 0; i < N; i++)
    {
      int r = (int)(f ());
      if (r>= 0 && r < BINS)
	count[r]++;
    }
  
  for (i = 0; i < BINS; i++)
    p[i] =  pdf(i) ;

  for (i = 0; i < BINS; i++)
    {
      double d = fabs(count[i] - N*p[i]) ;
      if (p[i] != 0)
	{
	  double s = d/sqrt(N*p[i]) ;
	  status_i = (s > 5) && (d > 1);
	}
      else
	{
	  status_i = (count[i] != 0) ;
	}
      status |= status_i ;
      if (status_i) 
	gsl_test (status_i, "%s i=%d (%g observed vs %g expected)", 
		  name, i, count[i]/N, p[i]) ;
    }

  if (status == 0)
    gsl_test (status, "%s, sampling against pdf over range [%d,%d) ", 
	      name, 0, BINS) ;
}

      

double
test_beta (void)
{
  return gsl_ran_beta (r_global, 2.0, 3.0);
}

double
test_beta_pdf (double x)
{
  return gsl_ran_beta_pdf (x, 2.0, 3.0);
}

double
test_bernoulli (void)
{
  return gsl_ran_bernoulli (r_global, 0.3);
}

double
test_bernoulli_pdf (unsigned int n)
{
  return gsl_ran_bernoulli_pdf (n, 0.3);
}


double
test_binomial (void)
{
  return gsl_ran_binomial (r_global, 0.3, 5);
}

double
test_binomial_pdf (unsigned int n)
{
  return gsl_ran_binomial_pdf (n, 0.3, 5);
}

double
test_binomial_large (void)
{
  return gsl_ran_binomial (r_global, 0.3, 55);
}

double
test_binomial_large_pdf (unsigned int n)
{
  return gsl_ran_binomial_pdf (n, 0.3, 55);
}

double
test_cauchy (void)
{
  return gsl_ran_cauchy (r_global, 2.0);
}

double
test_cauchy_pdf (double x)
{
  return gsl_ran_cauchy_pdf (x, 2.0);
}

double
test_chisq (void)
{
  return gsl_ran_chisq (r_global, 13.0);
}

double
test_chisq_pdf (double x)
{
  return gsl_ran_chisq_pdf (x, 13.0);
}

double
test_dir2d (void)
{
  double x=0, y=0, theta;
  gsl_ran_dir_2d (r_global, &x, &y);
  theta = atan2(x,y);
  return theta;
}

double
test_dir2d_pdf (double x)
{
  if (x > -M_PI && x <= M_PI)
    {
      return 1 / (2 * M_PI) ;
    }
  else
    {
      return 0 ;
    }
}

double
test_dir2d_trig_method (void)
{
  double x=0, y=0, theta;
  gsl_ran_dir_2d_trig_method (r_global, &x, &y);
  theta = atan2(x,y);
  return theta;
}

double
test_dir2d_trig_method_pdf (double x)
{
  if (x > -M_PI && x <= M_PI)
    {
      return 1 / (2 * M_PI) ;
    }
  else
    {
      return 0 ;
    }
}

double
test_dir3dxy (void)
{
  double x=0, y=0, z=0, theta;
  gsl_ran_dir_3d (r_global, &x, &y, &z);
  theta = atan2(x,y);
  return theta;
}

double
test_dir3dxy_pdf (double x)
{
  if (x > -M_PI && x <= M_PI)
    {
      return 1 / (2 * M_PI) ;
    }
  else
    {
      return 0 ;
    }
}

double
test_dir3dyz (void)
{
  double x=0, y=0, z=0, theta;
  gsl_ran_dir_3d (r_global, &x, &y, &z);
  theta = atan2(y,z);
  return theta;
}

double
test_dir3dyz_pdf (double x)
{
  if (x > -M_PI && x <= M_PI)
    {
      return 1 / (2 * M_PI) ;
    }
  else
    {
      return 0 ;
    }
}

double
test_dir3dzx (void)
{
  double x=0, y=0, z=0, theta;
  gsl_ran_dir_3d (r_global, &x, &y, &z);
  theta = atan2(z,x);
  return theta;
}

double
test_dir3dzx_pdf (double x)
{
  if (x > -M_PI && x <= M_PI)
    {
      return 1 / (2 * M_PI) ;
    }
  else
    {
      return 0 ;
    }
}

static gsl_ran_discrete_t *g1 = NULL;
static gsl_ran_discrete_t *g2 = NULL;

double
test_discrete1 (void)
{
    static double P[3]={0.59, 0.4, 0.01};
    if (g1==NULL) {
        g1 = gsl_ran_discrete_preproc(3,P);
    }
    return gsl_ran_discrete(r_global,g1);
}
double test_discrete1_pdf (unsigned int n)
{
    return gsl_ran_discrete_pdf((size_t)n,g1);
}

double
test_discrete2 (void)
{
    static double P[10]={ 1, 9, 3, 4, 5, 8, 6, 7, 2, 0 };
    if (g2==NULL) {
        g2 = gsl_ran_discrete_preproc(10,P);
    }
    return gsl_ran_discrete(r_global,g2);
}
double test_discrete2_pdf (unsigned int n)
{
    return gsl_ran_discrete_pdf((size_t)n,g2);
}

    
double
test_erlang (void)
{
  return gsl_ran_erlang (r_global, 3.0, 4.0);
}

double
test_erlang_pdf (double x)
{
  return gsl_ran_erlang_pdf (x, 3.0, 4.0);
}

double
test_exponential (void)
{
  return gsl_ran_exponential (r_global, 2.0);
}

double
test_exponential_pdf (double x)