#include <stdio.h>
#include <stdlib.h>
#include <time.h>
#include <gsl/gsl_sf_expint.h>
#include "SE_trans.h"

#define ALPHA 0.99
#define DOMD 3.14

double f(double t)
{
  return 0.25 * ((1+t) * log1p(t) + (1-t) * log1p(-t) - 2 * M_LN2) / M_LN2;
}

double G(double x)
{
  return 0.25 * x * SE_trans_div(-1, 1, x) / M_LN2;
}

double J(int j, double h, double x)
{
  return h * (0.5 + M_1_PI * gsl_sf_Si(M_PI * (x / h - j)));
}

double Fapp(double t, int m)
{
  double h = sqrt(M_PI*DOMD / (ALPHA*m));

  int j;
  double sum1 = 0;
  double sum2 = 0;

  for (j = -m; j <  0; j++) {
    sum1 += G(j*h) * J(j, h, SE_trans_inv(-1, 1, t));
  }
  for (j =  m; j >= 0; j--) {
    sum2 += G(j*h) * J(j, h, SE_trans_inv(-1, 1, t));
  }

  return (sum1 + sum2);
}

int main()
{
  int i;
  int n;
  double t;
  double err, maxerr;
  clock_t start, end;
  double time;

  int STEP = 1000;

  for (n = 3; n <= 150; n += 6) {
    start = clock();

    maxerr = 0;
    for (i = - STEP + 1; i <= STEP - 1; i++) {
      t = (double)i / (double)(STEP);

      err = fabs(f(t) - Fapp(t, n));
      maxerr = fmax(err, maxerr);
    }
    end = clock();

    time = (double)(end - start) / CLOCKS_PER_SEC;
    printf("%d\t%e\t%e\n", n, err, time);
  }

  return EXIT_SUCCESS;
}


/*
    This section is aimed to calculate the gaussian integrals that occurs in everywhere

    This part is greatly inspired by May, Andrew James. Density fitting in explicitly correlated electronic structure theory. Diss. University of Bristol, 2006.
 */

/*

Here is the table of the relation between the names and the definition:

S   <a|b>
J   (a|b) = <a|1/r_{12}|b>
G   (a|e^{-\gamma r_{12}^2}|b)
F   (a|f_{12}|b) = (a|c_i exp(-\gamma_i r_{12}^2)|b)
GJ  (a|e^{-\gamma r_{12}^2 r_12^{-1}}|b)
FJ  (a|f_{12} r_{12}^{-1}|b)
FF  (a|f_{12}^2|b)
FT  (ab|[\hat{t}_1, f_{12}]|c) = (ab|[- \frac{1}{2} \nabla ^2, f_{12}]|c)
FTF (a|\frac{1}{2}[f_12,[\hat{t}_1 + \hat{t}_2, f_{12}]]|b)
F-F (a|f_{12}|b|f_{23}|c)
J-F (a|r_{12}^{-1}|b|f_{23}|c)
X   (ab|[\hat{t}_1,r_{12}]|c)
Y   (ab|[\hat{t}_1,r_{12}^{-1}])
Z   (a|\frac{1}{r_{1Z}}|b)

Currently only S integrals and J integrals are supported.

 */

#ifndef __BASIS_H__
#define __BASIS_H__
#include "basis.h"
#endif

#include <math.h>

#include <gsl/gsl_vector.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_sf.h>

typedef struct gaussian_chain{
    double R[3];
    int a[3];

    double exponent;

    double coefficient;

    gaussian_chain * NEXT;

}gaussian_chain;

gaussian_chain * gaussian_chain_calloc();

void gaussian_chain_free(gaussian_chain * HEAD);

double gaussian_chain_get(gaussian_chain * HEAD,double x, double y, double z);
double orbital_get(orbital * orbital,double x, double y, double z);

double Gamma(double z);
double Boys(double x, int n);
double Binomials(int n, int k);

double f(int k, int a, int b, double PA, double PB);
double tranformation_coefficient(int a[3], int b[3], int p[3], double PA[3], double PB[3], double xi, double AB);

double SIntegral(double ra[3], double rb[3], int ax, int ay, int az, int bx, int by, int bz, double alpha,double beta);
double JIntegral(double ra[3], double rb[3], int ax, int ay, int az, int bx, int by, int bz, double alpha,double beta, int m);
double ZIntegral(double ra[3], double rb[3], double rz[3], int ax, int ay, int az, int bx, int by, int bz, double alpha, double beta, int m);

double gaussian_chain_SIntegral(gaussian_chain * a, gaussian_chain * b);
double gaussian_chain_JIntegral(gaussian_chain * a, gaussian_chain * b);
double gaussian_chain_ZIntegral(gaussian_chain * a, gaussian_chain * b, double rz[3]);
double gaussian_chain_full_SIntegral(gaussian_chain * a_HEAD, gaussian_chain * b_HEAD);
double gaussian_chain_full_JIntegral(gaussian_chain * a_HEAD, gaussian_chain * b_HEAD);
double gaussian_chain_full_ZIntegral(gaussian_chain * a_HEAD, gaussian_chain * b_HEAD, double rz[3]);

void gaussian_chain_derivative(gaussian_chain * dest, gaussian_chain * src, int key);
void gaussian_chain_second_derivative(gaussian_chain * dest, gaussian_chain * src, int key);
void gaussian_chain_laplacian(gaussian_chain * dest, gaussian_chain * src);

double gaussian_chain_kinetic_energy(gaussian_chain * a_HEAD, gaussian_chain * b_HEAD);

void single_electron_transform(gaussian_chain * HEAD, orbital * a);
void two_electron_transform(gaussian_chain * HEAD, orbital * a, orbital * b);

double orbital_SIntegral(orbital * a,orbital * b);
double orbital_JIntegral(orbital * a,orbital * b);
double orbital_ZIntegral(orbital * a,orbital * b, double rz[3]);
//double orbital_GIntegral(orbital *,orbital *);
//double orbital_FIntegral(orbital *,orbital *);
//double orbital_GJIntegral(orbital *,orbital *);
//double orbital_FJIntegral(orbital *,orbital *);
//double orbital_FFIntegral(orbital *,orbital *);

double two_electron_JIntegral(orbital * a_1, orbital * b_1, orbital * c_2, orbital * d_2);

double orbital_kinetic_energy(orbital * a, orbital * b);

void orbital_S_matrix(gsl_matrix * dest, orbital * HEAD);


/*
 * Calculation of Integral
 */
#include <stdio.h>

#include <gsl/gsl_rng.h>
#include <gsl/gsl_statistics.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_monte.h>
#include <gsl/gsl_monte_vegas.h>

#include "timer.h"

double g (double *t, size_t dim, void *params);

int main (void)
{
    double res, err;
    double dist, dmin = 1.001, dmax = 4.;
    size_t dim = 6;
    int np = 20;
    double vegas[20], vegaserr[20];
    double time1, time2;

    double dstep = (dmax - dmin) / (np - 1);

    double xl[] = { 0., 0., 0., 0., 0., 0. };
    double xu[] = { 1., 1., 1., 1., 1., 1. };

    gsl_rng *r = gsl_rng_alloc (gsl_rng_taus2);
    unsigned long seed = 1UL;

    gsl_rng_set (r, seed);

    size_t calls = 1000000;

    gsl_monte_function G = { &g, dim, &dist };

    gsl_monte_vegas_state *sv = gsl_monte_vegas_alloc (dim);

    gsl_monte_vegas_init (sv);

    dist = dmin;

// Vegas algorithm calculation

    timer_start ();

    // printf ("# Dist      Energy     ErrEst    Dipole\n");
    for (int i = 0; i < np; i++)
    {
        gsl_monte_vegas_integrate (&G, xl, xu, dim, calls / 5, r, sv, &res,
            &err);

        do
        {
            gsl_monte_vegas_integrate (&G, xl, xu, dim, calls, r, sv, &res,
                &err);
        }

        while (fabs (gsl_monte_vegas_chisq (sv) - 1.0) > 0.2);

        //printf ("% .6f  % .6f % .6f  % .6f\n", dist, res, err,
        //    -2. / pow (dist, 3.));

        //fflush (stdout);
        vegas[i] = res;
        vegaserr[i] = err;

        dist += dstep;
    }

    time1 = timer_stop ();

    gsl_monte_vegas_free (sv);

    dist = dmin;
    printf ("# Dist      HMC        Vegas      Verr       Dipole    Difference\n");

    double t[6];

// Calculation using homemade Monte Carlo algorithm

    timer_start ();

    for (int i = 0; i < np; i++)
    {
        double sum = 0.;

        for (int j = 0; j < (int) calls; j++)
        {
            for (int m = 0; m < (int) dim; m++)
            {
                t[m] = gsl_rng_uniform (r);
            }
            sum += g (t, dim, &dist);
        }
        double energy = sum / calls;
        double difference = fabs (energy - vegas[i]);

        printf ("% .6f  % .6f % .6f  % .6f  % .6f  % .6f\n",
            dist, energy, vegas[i], vegaserr[i], -2./pow(dist, 3.), difference );
        dist += dstep;

     }

   time2 = timer_stop ();
    printf ("Time Vegas: %.2f Time HMC: %.2f\n", time1, time2);
    printf ("Speedup: %.2f\n", time1 / time2);

    gsl_rng_free (r);

    return 0;
}


#include <stdlib.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_monte.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_complex.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_complex_math.h>
#include <gsl/gsl_cblas.h>
#include <gsl/gsl_blas.h>

#ifndef gauge_config
#include "config.h"
#define gauge_config 1

#define sq(x) ((x)*(x))
#define cb(x) ((x)*(x)*(x))
#endif

// SU(2) Matrix
// only the first row carries useful information (Lang p.80)
// note that for the first row must be normalized, i.e. |a|^2+ |b|^2 = 1
// use su2_normalize() for this
typedef struct{
  gsl_complex a;
  gsl_complex b;
} su2_matrix;

// SU(2) matrix methods --------------------------------------

// print matrix
void su2_print(const su2_matrix A){
  printf("%f + i*%f \t", GSL_REAL(A.a), GSL_IMAG(A.a));
  printf("%f + i*%f \n", GSL_REAL(A.b), GSL_IMAG(A.b));
}

// the identity matrix
su2_matrix su2_unit(){
  su2_matrix u;
  u.a=GSL_COMPLEX_ONE;
  u.b=GSL_COMPLEX_ZERO;
  return u;
}

// normalize matrix
su2_matrix su2_norm(const su2_matrix A){
  su2_matrix result;
  double norm = sqrt(gsl_complex_abs2(A.a)+gsl_complex_abs2(A.b));
  result.a = gsl_complex_div(A.a,gsl_complex_rect(norm,0));
  result.b = gsl_complex_div(A.b,gsl_complex_rect(norm,0));
  return result;
}

// multiply matrices
su2_matrix su2_mul(const su2_matrix A, const su2_matrix B){
  su2_matrix result;
  result.a = gsl_complex_sub(gsl_complex_mul(A.a,B.a), gsl_complex_mul(A.b,gsl_complex_conjugate(B.b))); // ac-bd*
  result.b = gsl_complex_add(gsl_complex_mul(A.a,B.b), gsl_complex_mul(A.b,gsl_complex_conjugate(B.a))); // ad+bc*
  return result;
}

// inverse matrix
su2_matrix su2_inv(const su2_matrix A){
  su2_matrix result;
  result.a = gsl_complex_conjugate(A.a);
  result.b = gsl_complex_sub(GSL_COMPLEX_ZERO,A.b);
  return result;
}

// generate random matrix
su2_matrix su2_rand(const gsl_rng* r){
  su2_matrix result;
  result.a = gsl_complex_rect(1,eps*(gsl_rng_uniform(r)*2-1));
  result.b = gsl_complex_rect(0,eps*(gsl_rng_uniform(r)*2-1));
  return su2_norm(result);
}

double su2_trace(const su2_matrix A){
  return 2*GSL_REAL(A.a);
}

// end of SU(2) matrix methods ---------------------------------------------


#include <gsl/gsl_math.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_randist.h>
#include <gsl/gsl_multifit.h>

int
main()
{
  const size_t n = 1000; /* number of observations */
  const size_t p = 2;    /* number of model parameters */
  size_t i;
  gsl_rng *r = gsl_rng_alloc(gsl_rng_default);
  gsl_matrix *X = gsl_matrix_alloc(n, p);
  gsl_vector *y = gsl_vector_alloc(n);

  for (i = 0; i < n; ++i)
    {
      /* generate first random variable u */
      double ui = 5.0 * gsl_ran_gaussian(r, 1.0);

      /* set v = u + noise */
      double vi = ui + gsl_ran_gaussian(r, 0.001);

      /* set y = u + v + noise */
      double yi = ui + vi + gsl_ran_gaussian(r, 1.0);

      /* since u =~ v, the matrix X is ill-conditioned */
      gsl_matrix_set(X, i, 0, ui);
      gsl_matrix_set(X, i, 1, vi);

      /* rhs vector */
      gsl_vector_set(y, i, yi);
    }

  {
    const size_t npoints = 200;                   /* number of points on L-curve and GCV curve */
    gsl_multifit_linear_workspace *w =
      gsl_multifit_linear_alloc(n, p);
    gsl_vector *c = gsl_vector_alloc(p);          /* OLS solution */
    gsl_vector *c_lcurve = gsl_vector_alloc(p);   /* regularized solution (L-curve) */
    gsl_vector *c_gcv = gsl_vector_alloc(p);      /* regularized solution (GCV) */
    gsl_vector *reg_param = gsl_vector_alloc(npoints);
    gsl_vector *rho = gsl_vector_alloc(npoints);  /* residual norms */
    gsl_vector *eta = gsl_vector_alloc(npoints);  /* solution norms */
    gsl_vector *G = gsl_vector_alloc(npoints);    /* GCV function values */
    double lambda_l;                              /* optimal regularization parameter (L-curve) */
    double lambda_gcv;                            /* optimal regularization parameter (GCV) */
    double G_gcv;                                 /* G(lambda_gcv) */
    size_t reg_idx;                               /* index of optimal lambda */
    double rcond;                                 /* reciprocal condition number of X */
    double chisq, rnorm, snorm;

    /* compute SVD of X */
    gsl_multifit_linear_svd(X, w);

    rcond = gsl_multifit_linear_rcond(w);
    fprintf(stderr, "matrix condition number = %e\n\n", 1.0 / rcond);

    /* unregularized (standard) least squares fit, lambda = 0 */
    gsl_multifit_linear_solve(0.0, X, y, c, &rnorm, &snorm, w);
    chisq = pow(rnorm, 2.0);

    fprintf(stderr, "=== Unregularized fit ===\n");
    fprintf(stderr, "best fit: y = %g u + %g v\n",
      gsl_vector_get(c, 0), gsl_vector_get(c, 1));
    fprintf(stderr, "residual norm = %g\n", rnorm);
    fprintf(stderr, "solution norm = %g\n", snorm);
    fprintf(stderr, "chisq/dof = %g\n", chisq / (n - p));

    /* calculate L-curve and find its corner */
    gsl_multifit_linear_lcurve(y, reg_param, rho, eta, w);
    gsl_multifit_linear_lcorner(rho, eta, &reg_idx);

    /* store optimal regularization parameter */
    lambda_l = gsl_vector_get(reg_param, reg_idx);

    /* regularize with lambda_l */
    gsl_multifit_linear_solve(lambda_l, X, y, c_lcurve, &rnorm, &snorm, w);
    chisq = pow(rnorm, 2.0) + pow(lambda_l * snorm, 2.0);

    fprintf(stderr, "\n=== Regularized fit (L-curve) ===\n");
    fprintf(stderr, "optimal lambda: %g\n", lambda_l);
    fprintf(stderr, "best fit: y = %g u + %g v\n",
            gsl_vector_get(c_lcurve, 0), gsl_vector_get(c_lcurve, 1));
    fprintf(stderr, "residual norm = %g\n", rnorm);
    fprintf(stderr, "solution norm = %g\n", snorm);
    fprintf(stderr, "chisq/dof = %g\n", chisq / (n - p));

    /* calculate GCV curve and find its minimum */
    gsl_multifit_linear_gcv(y, reg_param, G, &lambda_gcv, &G_gcv, w);

    /* regularize with lambda_gcv */
    gsl_multifit_linear_solve(lambda_gcv, X, y, c_gcv, &rnorm, &snorm, w);
    chisq = pow(rnorm, 2.0) + pow(lambda_gcv * snorm, 2.0);

    fprintf(stderr, "\n=== Regularized fit (GCV) ===\n");
    fprintf(stderr, "optimal lambda: %g\n", lambda_gcv);
    fprintf(stderr, "best fit: y = %g u + %g v\n",
            gsl_vector_get(c_gcv, 0), gsl_vector_get(c_gcv, 1));
    fprintf(stderr, "residual norm = %g\n", rnorm);
    fprintf(stderr, "solution norm = %g\n", snorm);
    fprintf(stderr, "chisq/dof = %g\n", chisq / (n - p));

    /* output L-curve and GCV curve */
    for (i = 0; i < npoints; ++i)
      {
        printf("%e %e %e %e\n",
               gsl_vector_get(reg_param, i),
               gsl_vector_get(rho, i),
               gsl_vector_get(eta, i),
               gsl_vector_get(G, i));
      }

    /* output L-curve corner point */
    printf("\n\n%f %f\n",
           gsl_vector_get(rho, reg_idx),
           gsl_vector_get(eta, reg_idx));

    /* output GCV curve corner minimum */
    printf("\n\n%e %e\n",
           lambda_gcv,
           G_gcv);

    gsl_multifit_linear_free(w);
    gsl_vector_free(c);
    gsl_vector_free(c_lcurve);
    gsl_vector_free(reg_param);
    gsl_vector_free(rho);
    gsl_vector_free(eta);
    gsl_vector_free(G);
  }

  gsl_rng_free(r);
  gsl_matrix_free(X);
  gsl_vector_free(y);

  return 0;
}


#include <stdlib.h>
#include <stdio.h>
#include <math.h>
#include <assert.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_integration.h>
#include <gsl/gsl_spline.h>
#include <gsl/gsl_sort.h>

#include "cosmocalc.h"

gsl_spline *cosmocalc_aexpn2comvdist_spline = NULL;
gsl_interp_accel *cosmocalc_aexpn2comvdist_acc = NULL;
gsl_spline *cosmocalc_comvdist2aexpn_spline = NULL;
gsl_interp_accel *cosmocalc_comvdist2aexpn_acc = NULL;
double DH_sqrtok;

/* function for integration using gsl integration */
static double comvdist_integ_funct(double a, void *p)
{
  return 1.0/a/a/hubble_noscale(a);
}

double comvdist_exact(double a)
{
#define WORKSPACE_NUM 100000
#define ABSERR 0.0
#define RELERR 1e-8

  gsl_integration_workspace *workspace;
  gsl_function F;
  double result,abserr;

  workspace = gsl_integration_workspace_alloc((size_t) WORKSPACE_NUM);

  F.function = &comvdist_integ_funct;
  gsl_integration_qag(&F,a,1.0,ABSERR,RELERR,(size_t) WORKSPACE_NUM,GSL_INTEG_GAUSS51,workspace,&result,&abserr);

  gsl_integration_workspace_free(workspace);

#undef ABSERR
#undef RELERR
#undef WORKSPACE_NUM

  return result*DH;
}

/* init function  - some help from Gadget-2 applied here */
void init_cosmocalc_comvdist_table(void)
{
#define WORKSPACE_NUM 100000
#define ABSERR 0.0
#define RELERR 1e-8

  static int initFlag = 1;
  static int currCosmoNum;

  gsl_integration_workspace *workspace;
  gsl_function F;
  long i;
  double result,abserr,afact;
  double comvdist_table[COSMOCALC_COMVDIST_TABLE_LENGTH];
  double aexpn_table[COSMOCALC_COMVDIST_TABLE_LENGTH];
  size_t sindex[COSMOCALC_COMVDIST_TABLE_LENGTH];
  double tmpDouble[COSMOCALC_COMVDIST_TABLE_LENGTH];

  if(initFlag == 1 || currCosmoNum != cosmoData.cosmoNum)
    {
      initFlag = 0;
      currCosmoNum = cosmoData.cosmoNum;

      if(cosmoData.OmegaK != 0.0)
	DH_sqrtok = DH/sqrt(fabs(cosmoData.OmegaK));
      else
	DH_sqrtok = 1.0;

      workspace = gsl_integration_workspace_alloc((size_t) WORKSPACE_NUM);

      for(i=0;i<COSMOCALC_COMVDIST_TABLE_LENGTH-1;++i)
	{
	  afact = (AEXPN_MAX - AEXPN_MIN_DIST)/(COSMOCALC_COMVDIST_TABLE_LENGTH-1.0)*((double) i) + AEXPN_MIN_DIST;
	  F.function = &comvdist_integ_funct;
	  F.params = &(cosmoData.OmegaM);
	  gsl_integration_qag(&F,afact,1.0,ABSERR,RELERR,(size_t) WORKSPACE_NUM,GSL_INTEG_GAUSS51,workspace,&result,&abserr);
	  aexpn_table[i] = afact;
	  comvdist_table[i] = result*DH;
	}
      aexpn_table[i] = 1.0;
      comvdist_table[i] = 0.0;

      gsl_integration_workspace_free(workspace);
#undef ABSERR
#undef RELERR
#undef WORKSPACE_NUM

      //init the spline and accelerators
      if(cosmocalc_aexpn2comvdist_spline != NULL)
	gsl_spline_free(cosmocalc_aexpn2comvdist_spline);
      cosmocalc_aexpn2comvdist_spline = gsl_spline_alloc(GSL_SPLINE_TYPE,(size_t) (COSMOCALC_COMVDIST_TABLE_LENGTH));
      gsl_spline_init(cosmocalc_aexpn2comvdist_spline,aexpn_table,comvdist_table,(size_t) (COSMOCALC_COMVDIST_TABLE_LENGTH));
      if(cosmocalc_aexpn2comvdist_acc != NULL)
	gsl_interp_accel_reset(cosmocalc_aexpn2comvdist_acc);
      else
	cosmocalc_aexpn2comvdist_acc = gsl_interp_accel_alloc();

      //sort the distances properly
      gsl_sort_index(sindex,comvdist_table,(size_t) 1,(size_t) (COSMOCALC_COMVDIST_TABLE_LENGTH));
      for(i=0;i<COSMOCALC_COMVDIST_TABLE_LENGTH;++i)
	tmpDouble[i] = comvdist_table[sindex[i]];
      for(i=0;i<COSMOCALC_COMVDIST_TABLE_LENGTH;++i)
	comvdist_table[i] = tmpDouble[i];
      for(i=0;i<COSMOCALC_COMVDIST_TABLE_LENGTH;++i)
	tmpDouble[i] = aexpn_table[sindex[i]];
      for(i=0;i<COSMOCALC_COMVDIST_TABLE_LENGTH;++i)
	aexpn_table[i] = tmpDouble[i];

      if(cosmocalc_comvdist2aexpn_spline != NULL)
	gsl_spline_free(cosmocalc_comvdist2aexpn_spline);
      cosmocalc_comvdist2aexpn_spline = gsl_spline_alloc(GSL_SPLINE_TYPE,(size_t) (COSMOCALC_COMVDIST_TABLE_LENGTH));
      gsl_spline_init(cosmocalc_comvdist2aexpn_spline,comvdist_table,aexpn_table,(size_t) (COSMOCALC_COMVDIST_TABLE_LENGTH));
      if(cosmocalc_comvdist2aexpn_acc != NULL)
	gsl_interp_accel_reset(cosmocalc_comvdist2aexpn_acc);
      else
	cosmocalc_comvdist2aexpn_acc = gsl_interp_accel_alloc();
    }
}

double acomvdist(double dist)
{
  static int initFlag = 1;
  static int currCosmoNum;

  if(initFlag == 1 || currCosmoNum != cosmoData.cosmoNum)
    {
      initFlag = 0;
      currCosmoNum = cosmoData.cosmoNum;
      init_cosmocalc_comvdist_table();
    }

  return gsl_spline_eval(cosmocalc_comvdist2aexpn_spline,dist,cosmocalc_comvdist2aexpn_acc);
}

double comvdist(double a)
{
  static int initFlag = 1;
  static int currCosmoNum;

  if(initFlag == 1 || currCosmoNum != cosmoData.cosmoNum)
    {
      initFlag = 0;
      currCosmoNum = cosmoData.cosmoNum;
      init_cosmocalc_comvdist_table();
    }

  return gsl_spline_eval(cosmocalc_aexpn2comvdist_spline,a,cosmocalc_aexpn2comvdist_acc);
}

//NOTE: you must call comvdist *FIRST* to init DH_sqrtok!
double angdist(double a)
{
  double cd;
  cd = comvdist(a);

  if(cosmoData.OmegaK > 0.0)
    return DH_sqrtok*sinh(cd/DH_sqrtok)*a;
  else if(cosmoData.OmegaK < 0)
    return DH_sqrtok*sin(cd/DH_sqrtok)*a;
  else
    return cd*a;
}

double lumdist(double a)
{
  double cd;
  cd = comvdist(a);

  if(cosmoData.OmegaK > 0.0)
    return DH_sqrtok*sinh(cd/DH_sqrtok)/a;
  else if(cosmoData.OmegaK < 0)
    return DH_sqrtok*sin(cd/DH_sqrtok)/a;
  else
    return cd/a;
}

double angdistdiff(double amin, double amax)
{
  double cdmin,cdmax;
  assert(amin <= amax);
  cdmin = comvdist(amin);
  cdmax = comvdist(amax);

  if(cosmoData.OmegaK > 0.0)
    return DH_sqrtok*sinh((cdmin-cdmax)/DH_sqrtok)*amin;
  else if(cosmoData.OmegaK < 0)
    return DH_sqrtok*sin((cdmin-cdmax)/DH_sqrtok)*amin;
  else
    return (cdmin-cdmax)*amin;
}


/*
 * Reinforcement Learning Book / Exercise 4.7
 *
 * $ sudo apt-get install libgsl-dev libgsl2
 * $ gcc car_rental2.c -lgsl -lgslcblas -lm -o car_rental2
 */

#include <stdio.h>
#include <stdlib.h>
#include <gsl/gsl_randist.h>

#define Size 20
#define Iteration 100
#define Rent1_mean 3
#define Rent2_mean 4
#define Return1_mean 3
#define Return2_mean 2

// Global variables
float value[Size + 1][Size + 1];
int policy[Size + 1][Size + 1];

void show_value(){
    printf("[");
    for (int c1 = 0; c1 <= Size; c1++) {
        printf("[");
        for (int c2 = 0; c2 <= Size; c2++) {
            printf("%3.0f", value[c1][c2]);
            if (c2 < Size) {
                printf(", ");
            }
        }
        printf("]");
        if (c1 < Size) {
            printf(",\n ");
        }
    }
    printf("]\n");
}

void show_policy(){
    printf("[");
    for (int c1 = 0; c1 <= Size; c1++) {
        printf("[");
        for (int c2 = 0; c2 <= Size; c2++) {
            printf("%2d", policy[c1][c2]);
            if (c2 < Size) {
                printf(", ");
            }
        }
        printf("]");
        if (c1 < Size) {
            printf(",\n ");
        }
    }
    printf("]\n");
}

float calc_q_val(int c1, int c2, int a){
    float q_val = 0;
    int _c1, _c2;
    float c1_rent_prob, c2_rent_prob, c1_return_prob, c2_return_prob, prob;

    // Moving cars
    c1 -= a;
    c2 += a;
    if (a > 0) {
        q_val -= 2*(a-1);
    } else {
        q_val -= 2*abs(a);
    }
    if (c1 > 10) q_val -= 4;
    if (c2 > 10) q_val -= 4;

    for (int c1_rent = 0; c1_rent <= c1; c1_rent++) {
        for (int c2_rent = 0; c2_rent <= c2; c2_rent++) {
            for (int c1_return = 0; c1_return <= Size-(c1-c1_rent); c1_return++) {
                for (int c2_return = 0; c2_return <= Size-(c2-c2_rent); c2_return++) {
                    _c1 = c1 - c1_rent + c1_return;
                    _c2 = c2 - c2_rent + c2_return;

                    if (c1_rent == c1) {
                        c1_rent_prob = 1;
                        for (int n = 0; n < c1_rent; n++) {
                            c1_rent_prob -= gsl_ran_poisson_pdf(n, Rent1_mean);
                        }
                    } else {
                        c1_rent_prob = gsl_ran_poisson_pdf(c1_rent, Rent1_mean);
                    }

                    if (c2_rent == c2) {
                        c2_rent_prob = 1;
                        for (int n = 0; n < c2_rent; n++) {
                            c2_rent_prob -= gsl_ran_poisson_pdf(n, Rent2_mean);
                        }
                    } else {
                        c2_rent_prob = gsl_ran_poisson_pdf(c2_rent, Rent2_mean);
                    }

                    if (c1_return == Size-(c1-c1_rent)) {
                        c1_return_prob = 1;
                        for (int n = 0; n < c1_return; n++) {
                            c1_return_prob -= gsl_ran_poisson_pdf(n, Return1_mean);
                        }
                    } else {
                        c1_return_prob = gsl_ran_poisson_pdf(c1_return, Return1_mean);
                    }

                    if (c2_return == Size-(c2-c2_rent)) {
                        c2_return_prob = 1;
                        for (int n = 0; n < c2_return; n++) {
                            c2_return_prob -= gsl_ran_poisson_pdf(n, Return2_mean);
                        }
                    } else {
                        c2_return_prob = gsl_ran_poisson_pdf(c2_return, Return2_mean);
                    }

                    prob = c1_rent_prob * c2_rent_prob * c1_return_prob * c2_return_prob;
                    q_val += prob * (10 * (c1_rent + c2_rent) + 0.9 * value[_c1][_c2]);
                }
            }
        }
    }
    return q_val;
}

int min(int a, int b){
    if (a < b) {
        return a;
    } else {
        return b;
    }
}

void run() {
    float q_val;
    float value_update;
    int policy_update;

    for (int c1 = 0; c1 <= Size; c1++) {
        for (int c2 = 0; c2 <= Size; c2++) {
            value[c1][c2] = 0;
            policy[c1][c2] = 0;
        }
    }

    printf("# Iteration 0\n");
    show_policy();
    show_value();

    for (int i = 1; i < Iteration; i++) {
        for (int c1 = 0; c1 <= Size; c1++) {
            for (int c2 = 0; c2 <= Size; c2++) {
                int update = 0;
                for (int a = -min(c2, 5); a <= min(c1, 5); a++) {
                    q_val = calc_q_val(c1, c2, a);
                    if (update == 0 || q_val > value_update) {
                        value_update = q_val;
                        policy_update = a;
                        update = 1;
                    }
                }
                value[c1][c2] = value_update;
                policy[c1][c2] = policy_update;
            }
        }
        printf("# Iteration %d\n", i);
        show_policy();
        show_value();
    }
}

int main() {
    run();
}


static char help[] = "Stiff ODE system.  Compare odejac.c.\n\n";

#include <petsc.h>

/* PYTHON:
import numpy as np
from scipy.linalg import expm
B = np.array([[0, 1, 0], [-1, 0, 0.1], [0, 0, -101]])
y = np.dot(expm(10*B),np.array([1.0,1.0,1.0]).transpose())
print y
RESULT:
[-1.383623   -0.29588643  0.        ]
*/

extern PetscErrorCode FormRHSFunction(TS, double, Vec, Vec, void*);
PetscErrorCode FormRHSJacobian(TS, double, Vec, Mat, Mat, void*);

int main(int argc,char **argv) {
  PetscErrorCode ierr;
  const int N = 3;
  int       steps;
  Vec       y;
  Mat       J;
  TS        ts;

  PetscInitialize(&argc,&argv,(char*)0,help);

  ierr = VecCreate(PETSC_COMM_WORLD,&y); CHKERRQ(ierr);
  ierr = VecSetSizes(y,PETSC_DECIDE,N); CHKERRQ(ierr);
  ierr = VecSetFromOptions(y); CHKERRQ(ierr);
  ierr = MatCreate(PETSC_COMM_WORLD,&J); CHKERRQ(ierr);
  ierr = MatSetSizes(J,PETSC_DECIDE,PETSC_DECIDE,N,N); CHKERRQ(ierr);
  ierr = MatSetFromOptions(J); CHKERRQ(ierr);
  ierr = MatSetUp(J); CHKERRQ(ierr);

  ierr = TSCreate(PETSC_COMM_WORLD,&ts); CHKERRQ(ierr);
  ierr = TSSetProblemType(ts,TS_NONLINEAR); CHKERRQ(ierr);
  ierr = TSSetRHSFunction(ts,NULL,FormRHSFunction,NULL); CHKERRQ(ierr);
  ierr = TSSetRHSJacobian(ts,J,J,FormRHSJacobian,NULL); CHKERRQ(ierr);

  ierr = TSSetType(ts,TSRK); CHKERRQ(ierr);
  ierr = TSSetTime(ts,0.0); CHKERRQ(ierr);
  ierr = TSSetMaxTime(ts,10.0); CHKERRQ(ierr);
  ierr = TSSetTimeStep(ts,1.0); CHKERRQ(ierr);
  ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_MATCHSTEP); CHKERRQ(ierr);
  ierr = TSSetFromOptions(ts); CHKERRQ(ierr);  // can override defaults

  ierr = VecSet(y,1.0); CHKERRQ(ierr);
  ierr = TSSolve(ts,y); CHKERRQ(ierr);

  ierr = VecView(y,PETSC_VIEWER_STDOUT_WORLD); CHKERRQ(ierr);
  ierr = TSGetStepNumber(ts,&steps); CHKERRQ(ierr);
  ierr = PetscPrintf(PETSC_COMM_WORLD,
              "total steps = %d\n",steps); CHKERRQ(ierr);

  VecDestroy(&y);  TSDestroy(&ts);  MatDestroy(&J);
  PetscFinalize();
  return 0;
}

PetscErrorCode FormRHSFunction(TS ts, double t, Vec y, Vec g, void *ptr) {
    const double *ay;
    double       *ag;
    VecGetArrayRead(y,&ay);
    VecGetArray(g,&ag);
    ag[0] = ay[1];
    ag[1] = - ay[0] + 0.1 * ay[2];
    ag[2] = - 101.0 * ay[2];
    VecRestoreArrayRead(y,&ay);
    VecRestoreArray(g,&ag);
    return 0;
}

PetscErrorCode FormRHSJacobian(TS ts, double t, Vec y, Mat J, Mat P,
                               void *ptr) {
    PetscErrorCode ierr;
    int    j[3] = {0, 1, 2};
    double v[9] = { 0.0, 1.0, 0.0,
                   -1.0, 0.0, 0.1,
                    0.0, 0.0, -101.0};
    ierr = MatSetValues(P,3,j,3,j,v,INSERT_VALUES); CHKERRQ(ierr);
    ierr = MatAssemblyBegin(P,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
    ierr = MatAssemblyEnd(P,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
    if (J != P) {
        ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
        ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
    }
    return 0;
}


#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <gsl/gsl_bspline.h>
#include <gsl/gsl_multifit.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_randist.h>
#include <gsl/gsl_statistics.h>

/* number of data points to fit */
#define N        200

/* number of fit coefficients */
#define NCOEFFS  12

/* nbreak = ncoeffs + 2 - k = ncoeffs - 2 since k = 4 */
#define NBREAK   (NCOEFFS - 2)

int
main (void)
{
  const size_t n = N;
  const size_t ncoeffs = NCOEFFS;
  const size_t nbreak = NBREAK;
  size_t i, j;
  gsl_bspline_workspace *bw;
  gsl_vector *B;
  double dy;
  gsl_rng *r;
  gsl_vector *c, *w;
  gsl_vector *x, *y;
  gsl_matrix *X, *cov;
  gsl_multifit_linear_workspace *mw;
  double chisq, Rsq, dof, tss;

  gsl_rng_env_setup();
  r = gsl_rng_alloc(gsl_rng_default);

  /* allocate a cubic bspline workspace (k = 4) */
  bw = gsl_bspline_alloc(4, nbreak);
  B = gsl_vector_alloc(ncoeffs);

  x = gsl_vector_alloc(n);
  y = gsl_vector_alloc(n);
  X = gsl_matrix_alloc(n, ncoeffs);
  c = gsl_vector_alloc(ncoeffs);
  w = gsl_vector_alloc(n);
  cov = gsl_matrix_alloc(ncoeffs, ncoeffs);
  mw = gsl_multifit_linear_alloc(n, ncoeffs);

  /* this is the data to be fitted */
  for (i = 0; i < n; ++i)
    {
      double sigma;
      double xi = (15.0 / (N - 1)) * i;
      double yi = cos(xi) * exp(-0.1 * xi);

      sigma = 0.1 * yi;
      dy = gsl_ran_gaussian(r, sigma);
      yi += dy;

      gsl_vector_set(x, i, xi);
      gsl_vector_set(y, i, yi);
      gsl_vector_set(w, i, 1.0 / (sigma * sigma));

      printf("%f %f\n", xi, yi);
    }

  /* use uniform breakpoints on [0, 15] */
  gsl_bspline_knots_uniform(0.0, 15.0, bw);

  /* construct the fit matrix X */
  for (i = 0; i < n; ++i)
    {
      double xi = gsl_vector_get(x, i);

      /* compute B_j(xi) for all j */
      gsl_bspline_eval(xi, B, bw);

      /* fill in row i of X */
      for (j = 0; j < ncoeffs; ++j)
        {
          double Bj = gsl_vector_get(B, j);
          gsl_matrix_set(X, i, j, Bj);
        }
    }

  /* do the fit */
  gsl_multifit_wlinear(X, w, y, c, cov, &chisq, mw);

  dof = n - ncoeffs;
  tss = gsl_stats_wtss(w->data, 1, y->data, 1, y->size);
  Rsq = 1.0 - chisq / tss;

  fprintf(stderr, "chisq/dof = %e, Rsq = %f\n",
                   chisq / dof, Rsq);

  printf("\n\n");

  /* output the smoothed curve */
  {
    double xi, yi, yerr;

    for (xi = 0.0; xi < 15.0; xi += 0.1)
      {
        gsl_bspline_eval(xi, B, bw);
        gsl_multifit_linear_est(B, c, cov, &yi, &yerr);
        printf("%f %f\n", xi, yi);
      }
  }

  gsl_rng_free(r);
  gsl_bspline_free(bw);
  gsl_vector_free(B);
  gsl_vector_free(x);
  gsl_vector_free(y);
  gsl_matrix_free(X);
  gsl_vector_free(c);
  gsl_vector_free(w);
  gsl_matrix_free(cov);
  gsl_multifit_linear_free(mw);

  return 0;
} /* main() */


/* randist/cauchy.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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 */

#include <config.h>
#include <math.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_randist.h>

/* The Cauchy probability distribution is

   p(x) dx = (1/(pi a)) (1 + (x/a)^2)^(-1) dx

   It is also known as the Lorentzian probability distribution */

double
gsl_ran_cauchy (const gsl_rng * r, const double a)
{
  double u;
  do
    {
      u = gsl_rng_uniform (r);
    }
  while (u == 0.5);

  return a * tan (M_PI * u);
}

double
gsl_ran_cauchy_pdf (const double x, const double a)
{
  double u = x / a;
  double p = (1 / (M_PI * a)) / (1 + u * u);
  return p;
}


/* expfit.c -- model functions for exponential + background */

#include <math.h>
#include <stddef.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_vector.h>

struct usertype {
  size_t n;
  double * y;
  double * sigma;
};

int expb_f (const gsl_vector * x, void *data,
        gsl_vector * f) {
  size_t n = ((struct usertype *)data)->n;
  double *y = ((struct usertype *)data)->y;
  double *sigma = ((struct usertype *) data)->sigma;

  double A = gsl_vector_get (x, 0);
  double lambda = gsl_vector_get (x, 1);
  double b = gsl_vector_get (x, 2);

  size_t i;

  for (i = 0; i < n; i++)
    {
      /* Model Yi = A * exp(-lambda * i) + b */
      double t = i;
      double Yi = A * exp (-lambda * t) + b;
      gsl_vector_set (f, i, (Yi - y[i])/sigma[i]);
    }

  return GSL_SUCCESS;
}

int expb_df (const gsl_vector * x, void *params,
         gsl_matrix * J) {

  struct usertype *myparams = (struct usertype *) params;

  int n = myparams->n;
  double *sigma = myparams->sigma;

  double A = gsl_vector_get (x, 0);
  double lambda = gsl_vector_get (x, 1);

  size_t i;

  /*for (i = 0; i<10; i++){
    printf("sigma[%z] = %5.3f\n",i,sigma[i]);
    }*/

  for (i = 0; i < n; i++)
    {
      /* Jacobian matrix J(i,j) = dfi / dxj, */
      /* where fi = (Yi - yi)/sigma[i],      */
      /*       Yi = A * exp(-lambda * i) + b  */
      /* and the xj are the parameters (A,lambda,b) */
      double t = i;
      double s = sigma[i];
      double e = exp(-lambda * t);
      gsl_matrix_set (J, i, 0, e/s);
      gsl_matrix_set (J, i, 1, -t * A * e/s);
      gsl_matrix_set (J, i, 2, 1/s);
    }
  return GSL_SUCCESS;
}

int expb_fdf (const gsl_vector * x, void *data,
          gsl_vector * f, gsl_matrix * J) {

  expb_f (x, data, f);
  expb_df (x, data, J);

  return GSL_SUCCESS;
}

void eval_F ( int fstatus, const int n, const int m,
	      const double *x, double *f, const void *params){

  // first, convert x from an array into a gsl_vector...
  gsl_vector * x_gsl = gsl_vector_alloc(n);
  int i;
  for (i = 0; i < n; i++) {
    gsl_vector_set(x_gsl,i,x[i]);
  }

  // then call the expb_f function
  gsl_vector * f_gsl =  gsl_vector_alloc(m);

  expb_f ( x_gsl,  params,  f_gsl);

  // then convert f back into an array...
  //  f = f_gsl->data;
  for (i = 0; i < m; i++){
    f[i] = gsl_vector_get( f_gsl,i);
    //    f[i] = f_gsl->data[i];
  }

  gsl_vector_free(x_gsl);
  gsl_vector_free(f_gsl);

}

void eval_J  ( int fstatus, const int n, const int m,
	       const double *x, double *J, const void *params){

  // first, convert x from an array into a gsl_vector...
  gsl_vector * x_gsl = gsl_vector_alloc(n);
  int i;
  int jj;
  for (i = 0; i < n; i++) {
    gsl_vector_set(x_gsl,i,x[i]);
  }

  // then call the expb_f function
  gsl_matrix * J_gsl = gsl_matrix_alloc(40,3);
  expb_df (x_gsl, params, J_gsl);

  // then convert J into an array...
  // (find better way...)
  gsl_matrix * J_gsl_t = gsl_matrix_alloc(3,40);
  gsl_matrix_transpose_memcpy(J_gsl_t, J_gsl);
  for ( i = 0; i < m*n; i++){
    J[i] = J_gsl_t->data[i];
  }
  // the following code loses the pointer to J (maybe...)
  // J = J_gsl_t->data;
  gsl_vector_free(x_gsl);
  gsl_matrix_free(J_gsl);
  gsl_matrix_free(J_gsl_t);

}

void eval_HF ( int fstatus, const int n, const int m,
	       const double *x, const double *f, double *hf, const void *params){

}


#include <stdlib.h>
#include <stdio.h>
#include "linterp.h"
#include "qspline.h"
#include "cspline.h"
#include <gsl/gsl_spline.h>

#define NUM_DATAPOINTS 9

/** Read a txt file with two columns seperated by tab and read all the items
 * into the arrays x and y.
 **/
void read_data(double *x, double *y){
    FILE *infile = fopen("xy_data.txt", "r");
    for (int i = 0; i < NUM_DATAPOINTS; ++i){
        int items = fscanf(infile, "%lf\t%lf\n", &x[i], &y[i]);
        if (items == EOF){
            break;
        }
    }
    fclose(infile);
}

void exerciseA(){
    FILE *outfile = fopen("out1.txt", "w");
    double *x, *y;
    x = (double *) malloc(sizeof(double *) * NUM_DATAPOINTS);
    y = (double *) malloc(sizeof(double *) * NUM_DATAPOINTS);
    read_data(x, y);

    gsl_interp_accel *acc = gsl_interp_accel_alloc ();
    gsl_spline *spline = gsl_spline_alloc (gsl_interp_linear, NUM_DATAPOINTS);

    gsl_spline_init (spline, x, y, NUM_DATAPOINTS);

    double val = 0.1;
    do {
        double interp_val = linterp(NUM_DATAPOINTS, x, y, val);
        double interp_val_integ = linterp_integ(NUM_DATAPOINTS, x, y, val);
        double y_gsl = gsl_spline_eval(spline, val, acc);
        fprintf(outfile, "%f\t%f\t%f\t%f\n", val, interp_val, interp_val_integ, y_gsl);
        val += 0.1;
    } while (val < 8);
    gsl_spline_free (spline);
    gsl_interp_accel_free (acc);
    free(x), free(y);
    fclose(outfile);
}

void exerciseB(){
    FILE *outfile = fopen("out2.txt", "w");
    double *x, *y;
    x = (double *) malloc(sizeof(double *) * NUM_DATAPOINTS);
    y = (double *) malloc(sizeof(double *) * NUM_DATAPOINTS);
    read_data(x, y);

    double val = 0.1;
    do {
        double interp_val = qspline_eval(NUM_DATAPOINTS, x, y, val);
        double interp_val_integ = qspline_integ(NUM_DATAPOINTS, x, y, val);
        double interp_val_deriv = qspline_deriv(NUM_DATAPOINTS, x, y, val);
        fprintf(outfile, "%f\t%f\t%f\t%f\n", val, interp_val, interp_val_integ, interp_val_deriv);
        val += 0.1;
    } while (val < 8);
    free(x), free(y);
    fclose(outfile);
}

void exerciseC(){
    FILE *outfile = fopen("out3.txt", "w");
    double *x, *y;
    x = (double *) malloc(sizeof(double *) * NUM_DATAPOINTS);
    y = (double *) malloc(sizeof(double *) * NUM_DATAPOINTS);
    read_data(x, y);

    gsl_interp_accel *acc = gsl_interp_accel_alloc ();
    gsl_spline *spline = gsl_spline_alloc (gsl_interp_cspline, NUM_DATAPOINTS);

    gsl_spline_init (spline, x, y, NUM_DATAPOINTS);

    double val = 0.1;
    do {
        double interp_val = cspline_eval(NUM_DATAPOINTS, x, y, val);
        double interp_val_integ = cspline_integ(NUM_DATAPOINTS, x, y, val);
        double y_gsl = gsl_spline_eval(spline, val, acc);
        fprintf(outfile, "%f\t%f\t%f\t%f\n", val, interp_val, interp_val_integ, y_gsl);
        val += 0.1;
    } while (val < 8);
    gsl_spline_free (spline);
    gsl_interp_accel_free (acc);
    free(x), free(y);
    fclose(outfile);
}

int main(){
    exerciseA();
    exerciseB();
    exerciseC();
    return 0;
}


#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <math.h>
#ifndef NOMPI
#include <mpi.h>
#endif
#include <gsl/gsl_math.h>
#include <gsl/gsl_integration.h>

#include "allvars.h"
#include "proto.h"

/*! \file driftfac.c
 *  \brief compute loop-up tables for prefactors in cosmological integration
 */

static double logTimeBegin;
static double logTimeMax;

/*! This function computes look-up tables for factors needed in
 *  cosmological integrations. The (simple) integrations are carried out
 *  with the GSL library.  Separate factors are computed for the "drift",
 *  and the gravitational and hydrodynamical "kicks".  The lookup-table is
 *  used for reasons of speed.
 */
void init_drift_table(void)
{
#define WORKSIZE 100000
  int i;
  double result, abserr;
  gsl_function F;
  gsl_integration_workspace *workspace;

  logTimeBegin = log(All.TimeBegin);
  logTimeMax = log(All.TimeMax);

  workspace = gsl_integration_workspace_alloc(WORKSIZE);

  for(i = 0; i < DRIFT_TABLE_LENGTH; i++)
    {
      F.function = &drift_integ;
      gsl_integration_qag(&F, exp(logTimeBegin), exp(logTimeBegin + ((logTimeMax - logTimeBegin) / DRIFT_TABLE_LENGTH) * (i + 1)), 0,
			  1.0e-8, WORKSIZE, GSL_INTEG_GAUSS41, workspace, &result, &abserr);
      DriftTable[i] = result;

      F.function = &gravkick_integ;
      gsl_integration_qag(&F, exp(logTimeBegin), exp(logTimeBegin + ((logTimeMax - logTimeBegin) / DRIFT_TABLE_LENGTH) * (i + 1)), 0,
			  1.0e-8, WORKSIZE, GSL_INTEG_GAUSS41, workspace, &result, &abserr);
      GravKickTable[i] = result;

      F.function = &hydrokick_integ;
      gsl_integration_qag(&F, exp(logTimeBegin), exp(logTimeBegin + ((logTimeMax - logTimeBegin) / DRIFT_TABLE_LENGTH) * (i + 1)), 0,
			  1.0e-8, WORKSIZE, GSL_INTEG_GAUSS41, workspace, &result, &abserr);
      HydroKickTable[i] = result;
    }

  gsl_integration_workspace_free(workspace);
}

/*! This function integrates the cosmological prefactor for a drift step
 *  between time0 and time1. The value returned is * \f[ \int_{a_0}^{a_1}
 *  \frac{{\rm d}a}{H(a)} * \f]
 */
double get_drift_factor(int time0, int time1)
{
  double a1, a2, df1, df2, u1, u2;
  int i1, i2;

  /* note: will only be called for cosmological integration */

  a1 = logTimeBegin + time0 * All.Timebase_interval;
  a2 = logTimeBegin + time1 * All.Timebase_interval;

  u1 = (a1 - logTimeBegin) / (logTimeMax - logTimeBegin) * DRIFT_TABLE_LENGTH;
  i1 = (int) u1;
  if(i1 >= DRIFT_TABLE_LENGTH)
    i1 = DRIFT_TABLE_LENGTH - 1;

  if(i1 <= 1)
    df1 = u1 * DriftTable[0];
  else
    df1 = DriftTable[i1 - 1] + (DriftTable[i1] - DriftTable[i1 - 1]) * (u1 - i1);

  u2 = (a2 - logTimeBegin) / (logTimeMax - logTimeBegin) * DRIFT_TABLE_LENGTH;
  i2 = (int) u2;
  if(i2 >= DRIFT_TABLE_LENGTH)
    i2 = DRIFT_TABLE_LENGTH - 1;

  if(i2 <= 1)
    df2 = u2 * DriftTable[0];
  else
    df2 = DriftTable[i2 - 1] + (DriftTable[i2] - DriftTable[i2 - 1]) * (u2 - i2);

  return df2 - df1;
}

/*! This function integrates the cosmological prefactor for a kick step of
 *  the gravitational force.
 */
double get_gravkick_factor(int time0, int time1)
{
  double a1, a2, df1, df2, u1, u2;
  int i1, i2;

  /* note: will only be called for cosmological integration */

  a1 = logTimeBegin + time0 * All.Timebase_interval;
  a2 = logTimeBegin + time1 * All.Timebase_interval;

  u1 = (a1 - logTimeBegin) / (logTimeMax - logTimeBegin) * DRIFT_TABLE_LENGTH;
  i1 = (int) u1;
  if(i1 >= DRIFT_TABLE_LENGTH)
    i1 = DRIFT_TABLE_LENGTH - 1;

  if(i1 <= 1)
    df1 = u1 * GravKickTable[0];
  else
    df1 = GravKickTable[i1 - 1] + (GravKickTable[i1] - GravKickTable[i1 - 1]) * (u1 - i1);

  u2 = (a2 - logTimeBegin) / (logTimeMax - logTimeBegin) * DRIFT_TABLE_LENGTH;
  i2 = (int) u2;
  if(i2 >= DRIFT_TABLE_LENGTH)
    i2 = DRIFT_TABLE_LENGTH - 1;

  if(i2 <= 1)
    df2 = u2 * GravKickTable[0];
  else
    df2 = GravKickTable[i2 - 1] + (GravKickTable[i2] - GravKickTable[i2 - 1]) * (u2 - i2);

  return df2 - df1;
}

/*! This function integrates the cosmological prefactor for a kick step of
 *  the hydrodynamical force.
 */
double get_hydrokick_factor(int time0, int time1)
{
  double a1, a2, df1, df2, u1, u2;
  int i1, i2;

  /* note: will only be called for cosmological integration */

  a1 = logTimeBegin + time0 * All.Timebase_interval;
  a2 = logTimeBegin + time1 * All.Timebase_interval;

  u1 = (a1 - logTimeBegin) / (logTimeMax - logTimeBegin) * DRIFT_TABLE_LENGTH;
  i1 = (int) u1;
  if(i1 >= DRIFT_TABLE_LENGTH)
    i1 = DRIFT_TABLE_LENGTH - 1;

  if(i1 <= 1)
    df1 = u1 * HydroKickTable[0];
  else
    df1 = HydroKickTable[i1 - 1] + (HydroKickTable[i1] - HydroKickTable[i1 - 1]) * (u1 - i1);

  u2 = (a2 - logTimeBegin) / (logTimeMax - logTimeBegin) * DRIFT_TABLE_LENGTH;
  i2 = (int) u2;
  if(i2 >= DRIFT_TABLE_LENGTH)
    i2 = DRIFT_TABLE_LENGTH - 1;

  if(i2 <= 1)
    df2 = u2 * HydroKickTable[0];
  else
    df2 = HydroKickTable[i2 - 1] + (HydroKickTable[i2] - HydroKickTable[i2 - 1]) * (u2 - i2);

  return df2 - df1;
}

/*! Integration kernel for drift factor computation.
 */
double drift_integ(double a, void *param)
{
  double h;

  h = All.Omega0 / (a * a * a) + (1 - All.Omega0 - All.OmegaLambda) / (a * a) + All.OmegaLambda;
  h = All.Hubble * sqrt(h);

  return 1 / (h * a * a * a);
}

/*! Integration kernel for gravitational kick factor computation.
 */
double gravkick_integ(double a, void *param)
{
  double h;

  h = All.Omega0 / (a * a * a) + (1 - All.Omega0 - All.OmegaLambda) / (a * a) + All.OmegaLambda;
  h = All.Hubble * sqrt(h);

  return 1 / (h * a * a);
}

/*! Integration kernel for hydrodynamical kick factor computation.
 */
double hydrokick_integ(double a, void *param)
{
  double h;

  h = All.Omega0 / (a * a * a) + (1 - All.Omega0 - All.OmegaLambda) / (a * a) + All.OmegaLambda;
  h = All.Hubble * sqrt(h);

  return 1 / (h * pow(a, 3 * GAMMA_MINUS1) * a);
}

double growthfactor_integ(double a, void *param)
{
  double s;

  s = All.Omega0 + (1 - All.Omega0 - All.OmegaLambda) * a + All.OmegaLambda * a * a * a;
  s = sqrt(s);

  return pow(sqrt(a) / s, 3);
}


#include <stdio.h>
#include <stdlib.h>
#include <math.h>

#include <gsl/gsl_errno.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_roots.h>

#include "ccl.h"

/*
 * convert_concentration_single finds the concentration c'
 * for a mass definition with overdensity Delta' given
 * the concentration c for a mass definition with overdensity
 * Delta assuming an NFW density profile.
 *
 * To do so, it solves the following equation numerically:
 *    c^3 * f(c) = Delta' f(c')
 * where f(x) = x^3 * (x + 1) / ((1+x) * log(x + 1) - x).
 *
 * The equation is solved using a Newton-Raphson approach.
 * The functions nfw_fx, nfw_f, nfw_df and nfw_fdf implement
 * the function whose zero we try to find and its derivative.
 *
 * ccl_convert_concentration does the same thing for an
 * array of input concentrations.
 */

static double nfw_fx(double x)
{
  if(x>0.01) {
    double xp1=1+x;
    double lxp1=log(xp1);
    double den=1./(xp1*lxp1-x);
    return xp1*x*x*x*den;
  }
  else {
    return 2*x;
  }
}

static double nfw_f(double x,void *params)
{
  double offset = *((double *)params);
  return nfw_fx(x)-offset;
}

static double nfw_df(double x,void *params)
{
  if(x>0.01) {
    double xp1=1+x;
    double lxp1=log(xp1);
    double den=1./(xp1*lxp1-x);
    return x*x*(3*xp1*xp1*lxp1-x*(4*x+3))*den*den;
  }
  else {
    return 2;
  }
}

static void nfw_fdf(double x,void *params,
		    double *y, double *dy)
{
  double offset = *((double *)params);
  if(x>0.01) {
    double xp1=1+x;
    double lxp1=log(xp1);
    double den=1./(xp1*lxp1-x);
    *y=xp1*x*x*x*den-offset;
    *dy=x*x*(3*xp1*xp1*lxp1-x*(4*x+3))*den*den;
  }
  else {
    *y=2*x-offset;
    *dy=2;
  }
}

static int convert_concentration_single(double d_factor, double c_old,
					double *c_new, double c_start)
{
  double c0, offset = d_factor * nfw_fx(c_old);
  int status, iter=0, max_iter=100;
  gsl_function_fdf FDF;
  gsl_root_fdfsolver *s=NULL;
  FDF.f = &nfw_f;
  FDF.df = &nfw_df;
  FDF.fdf = &nfw_fdf;
  FDF.params = &offset;

  s=gsl_root_fdfsolver_alloc(gsl_root_fdfsolver_newton);
  if (s==NULL)
    return CCL_ERROR_MEMORY;

  gsl_root_fdfsolver_set (s, &FDF, c_start);
  *c_new = c_start;
  do
    {
      iter++;
      c0 = *c_new;
      status = gsl_root_fdfsolver_iterate (s);
      *c_new = gsl_root_fdfsolver_root (s);
      status = gsl_root_test_delta (*c_new, c0, 0, 1e-4);

    }
  while (status == GSL_CONTINUE && iter < max_iter);
  gsl_root_fdfsolver_free (s);

  return status;
}

void ccl_convert_concentration(ccl_cosmology *cosmo,
			       double delta_old, int nc, double c_old[],
			       double delta_new, double c_new[],int *status)
{
  if(nc<=0)
    return;

  int ii,st=0;
  double d_factor = delta_old/delta_new;
  for(ii=0;ii<nc;ii++) {
    double c_new_h;
    st=convert_concentration_single(d_factor, c_old[ii], &(c_new[ii]), c_old[ii]);
    if(st!=GSL_SUCCESS) {
      *status=CCL_ERROR_ROOT;
      ccl_cosmology_set_status_message(cosmo,
				       "ccl_mass_conversion.c: NR solver failed to find a root\n");
      return;
    }
  }
}


#include <stdio.h>
#include<stdlib.h>
#include <math.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_linalg.h>
#include <gsl/gsl_blas.h>

void *xcalloc(int items, int size)
{
	void *ptr = calloc(items, size);
	if (ptr == NULL)
	{
		printf("Unable to allocate memory\n");
		exit(EXIT_FAILURE);
	}
	return ptr;
}

void GetLGLPoints(int N, double *x)
{
	if (N == 0)
	{
		printf("Support for constants doesn't exist\n");
		exit(1);
	}
	else if (N == 1)
	{
		x[0] = -1.0;
		x[1] = 1.0;
	}
	else if (N==2)
	{
		x[0] = -1.0;
		x[1] = 0.0;
		x[2] = 1.0;
	}
	else if (N==3)
	{
		x[0] = -1.0;
		x[1] = -0.4472;
		x[2] = 0.4472;
		x[3] = 1.0;
	}
	else if (N==4)
	{
		x[0] = -1.0;
		x[1] = -0.6547;
		x[2] = 0;
		x[3] = 0.6547;
		x[4] = 1.0;
	}
	else
	{
		printf("Currently only have up to fourth order polynomial encoded for LGL points\n");
		exit(1);
	}
}

void GetLGLWeights(int N, double *w)
{
	if (N == 0)
	{
		printf("Support for constants doesn't exist\n");
		exit(1);
	}
	else if (N == 1)
	{
		w[0] = 1.0;
		w[1] = 1.0;
	}
	else if (N==2)
	{
		w[0] = 0.3333333333333;
		w[1] = 1.3333333333333;
		w[2] = 0.3333333333333;
	}
	else if (N==3)
	{
		w[0] = 0.16666666666667;
		w[1] = 0.83333333333333;
		w[2] = 0.83333333333333;
		w[3] = 0.16666666666667;
	}
	else if (N==4)
	{
		w[0] = 0.1;
		w[1] = 0.5444444;
		w[2] = 0.7111111;
		w[3] = 0.5444444;
		w[4] = 0.1;
	}
	else
	{
		printf("Currently only have up to fourth order polynomial encoded for LGL points\n");
		exit(1);
	}

}

void calculateNodalCoordinates(int N, int NumEl, double* X, double* Xnodes)
{
	double r[N+1];
	GetLGLPoints(N, r);
	for(int i = 0; i < NumEl; i++)
	{
		for (int j = 0; j < N+1; j++)
		{
			Xnodes[i*(N+1)+j] = X[i] + 0.5*(r[j]+1)*(X[i+1]-X[i]);
		}
	}

}

void LegendrePoly(double *x, int Np, int N, double* P)
{
	// Purpose: Evaluates the normalized Legendre polynomials
	// 					at points x for order N and returns the values in the
	// 					array P that is Np long

	double aold = 0.0, anew=0.0;

	double **PL = xcalloc(N+1, sizeof(double*));
	for (int i =0; i < N+1; i++)
	{
		PL[i] =  xcalloc(Np, sizeof(double));
	}

	// Initial values P_0(x) and P_1(x)
	if (N==0)
	{
		double constVal = 1.0/sqrt(2);
		for (int j = 0; j < Np; j++)
		{
			P[j] = constVal;
		}

		free(PL[0]);
		free(PL);
		return;
	}
	else
	{
		for (int j = 0; j < Np; j++)
		{
			PL[0][j] = 1.0/sqrt(2);
		}
	}

	double *prow = xcalloc(Np, sizeof(double));
	double coeff = sqrt(1.5);
	for (int i = 0; i < Np; i++)
	{
		prow[i] = coeff*x[i];
	}

	if(N==1)
	{
		for (int i = 0; i < Np; i++)
		{
			P[i] = prow[i];
		}
		free(prow);
		free(PL[0]);
		free(PL[1]);
		free(PL);
		return;
	}
	else
	{
		for (int j =0; j < Np; j++)
		{
			PL[1][j] = coeff*x[j];
		}

	}

	// Repeat value in recurrence
	aold = sqrt(1.0/3);

	// Forward recurrence
	for (int i = 2; i <= N; i++)
	{
		anew = sqrt(i*i/((2.0*i+1)*(2*i-1)));
		for (int j = 0; j < Np; j++)
		{
			PL[i][j] = (x[j]*PL[i-1][j]-aold*PL[i-2][j])/anew;
		}
		aold = anew;
	}

	for (int j = 0; j < Np; j++)
	{
		P[j] = PL[N][j];
	}

	for (int i =0; i < N; i++)
	{
		free(PL[i]);
	}
	free(PL);

	return;
}

void Vandermonde1D(double *x, int Np, int N, gsl_matrix** V1D)
{
	// Purpose: Evaluates the Vandermonde matrix V_{ij} = phi_i(r_j);

	*V1D = gsl_matrix_alloc(Np, N+1);
	double V1DT[Np];
	for(int i = 0; i < N+1; i++)
	{
			LegendrePoly(x, Np, i, V1DT);
			for (int j = 0; j < Np; j++)
			{
				gsl_matrix_set(*V1D, i, j, V1DT[j]);
				//gsl_matrix_set(*V1D, j, i, V1DT[j]);
			}
	}
}

void GradLegendrePoly(double *x, int Np, int N, double* DP)
{
	// Purpose: Evaluates the derivatives of normalized Legendre polynomial
	// 					at points x for order N and returns the values in the
	// 					array P that is Np long
	//

	double aold, anew;

	double **DPL = xcalloc(N+1, sizeof(double*));
	for (int i =0; i < N+1; i++)
	{
		DPL[i] =  xcalloc(Np, sizeof(double));
	}

	// Initial values P_0(x) and P_1(x)
	if (N==0)
	{
		for (int j = 0; j < Np; j++)
		{
			DP[0] = 0;
		}
		free(DPL[0]);
		free(DPL);
		return;
	}
	else
	{
		for (int j = 0; j < Np; j++)
		{
			DPL[0][j] = 0;
		}
	}

	double *dprow = xcalloc(Np, sizeof(double));
	double deriv = sqrt(1.5);
	for (int i = 0; i < Np; i++)
	{
		dprow[i] = deriv;
	}

	if(N==1)
	{
		for (int i = 0; i < Np; i++)
		{
			DP[i] = deriv;
		}
		free(dprow);
		free(DPL[0]);
		free(DPL[1]);
		free(DPL);
		return;
	}
	else
	{
		for (int j =0; j < Np; j++)
		{
			DPL[1][j] = deriv;
		}

	}

	// Repeat value in recurrence
	aold = sqrt(1.0/3);

	// Forward recurrence
	for (int i = 2; i <= N; i++)
	{
		anew = sqrt(i*i/((2.0*i+1)*(2*i-1)));
		double P[Np];
		LegendrePoly(x, Np, i-1, P);
		for (int j = 0; j < Np; j++)
		{
			DPL[i][j] = 1.0/(anew)*(P[j] + x[j]*DPL[i-1][j] - aold*DPL[i-2][j]);
		}
		aold = anew;
	}

	for (int j = 0; j < Np; j++)
	{
		DP[j] = DPL[N][j];
	}

	for (int i =0; i < N; i++)
	{
		free(DPL[i]);
	}
	free(DPL);

	return;

}

void GradVandermonde1D(double *r, int Np, int N, gsl_matrix** GV)
{
	// Purpose: Evaluates the gradient of modal basis (i) at (r)
	// 					at order N and return them in GV whose size is
	// 					ixNp
	//
	*GV = gsl_matrix_alloc(Np, N+1);
	double GVT[Np];
	for (int i =0; i < N+1; i++)
	{
		GradLegendrePoly(r, Np, i, GVT);
		for (int j = 0; j < Np; j++)
			gsl_matrix_set(*GV,i,j, GVT[j]);
			//gsl_matrix_set(*GV,j,i,GVT[j]);
	}

}

void VolIntMat1D(double *x, int N, gsl_matrix* V, gsl_matrix *Vr, gsl_matrix** VolMat)
{

	gsl_permutation *p = gsl_permutation_alloc(N+1);
	gsl_matrix *Vcopy = gsl_matrix_alloc(N+1, N+1);
	gsl_matrix_memcpy(Vcopy, V);

	gsl_matrix *Vinv = gsl_matrix_alloc(N+1, N+1);

	int s;
	gsl_linalg_LU_decomp(Vcopy, p, &s);
	gsl_linalg_LU_invert(Vcopy, p, Vinv);

	gsl_matrix *tmp1 = gsl_matrix_alloc(N+1, N+1);
	gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1.0, Vinv, Vinv, 0.0, tmp1);

	gsl_matrix *tmp2 = gsl_matrix_alloc(N+1, N+1);
	gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, Vr, tmp1, 0.0, tmp2);

	*VolMat = gsl_matrix_alloc(N+1, N+1);
	gsl_blas_dgemm(CblasTrans, CblasNoTrans, 1.0, V, tmp2, 0.0, *
VolMat);
	//gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, Vr, Vinv, 0.0, *Dr);

	gsl_permutation_free(p);
	gsl_matrix_free(Vcopy);
	gsl_matrix_free(Vinv);
	gsl_matrix_free(tmp1);
	gsl_matrix_free(tmp2);

}

void Lift1D(int Np, gsl_matrix *V, gsl_matrix **LIFT)
{
	*LIFT = gsl_matrix_alloc(Np,2);

	gsl_matrix *EMAT = gsl_matrix_calloc(Np, 2);
	gsl_matrix_set(EMAT, 0, 0, 1.0);
	gsl_matrix_set(EMAT, Np-1, 1, -1.0);

	gsl_matrix *tmp = gsl_matrix_alloc(Np,2);
	gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, V, EMAT, 0.0, tmp);
	gsl_blas_dgemm(CblasTrans, CblasNoTrans, 1.0, V, tmp, 0.0, *LIFT);

	gsl_matrix_free(EMAT);
	gsl_matrix_free(tmp);

}

void calculateMassMatrix(int Np, gsl_matrix* V, gsl_matrix** MassMatrix)
{
	*MassMatrix = gsl_matrix_alloc(Np,Np);
	gsl_matrix *MassMatrixInv = gsl_matrix_alloc(Np,Np);
	gsl_blas_dgemm(CblasTrans, CblasNoTrans, 1.0, V, V, 0.0, MassMatrixInv);

	int s = 0;
	gsl_permutation *p = gsl_permutation_alloc(Np);
	gsl_linalg_LU_decomp(MassMatrixInv, p, &s);
	gsl_linalg_LU_invert(MassMatrixInv, p, *MassMatrix);

	gsl_matrix_free(MassMatrixInv);
	gsl_permutation_free(p);

}

void calculateLIFTVolMat(int N, int Np, gsl_matrix **LIFT, gsl_matrix **VolMat,gsl_matrix **MassMatrix)
{
	double r[Np];
	GetLGLPoints(N,r);

	gsl_matrix *V;
	gsl_matrix *GV;

	Vandermonde1D(r,Np,N,&V);
	GradVandermonde1D(r, Np, N, &GV);
	VolIntMat1D(r, N, V, GV, VolMat);
	Lift1D(Np, V, LIFT);
	calculateMassMatrix(Np, V,MassMatrix);

	gsl_matrix_free(V);
	gsl_matrix_free(GV);

}


#include <stdlib.h>
#include <stdio.h>
#include <math.h>
#include <assert.h>
#include <gsl/gsl_math.h>

#include "cosmocalc.h"

double weff(double a)
{
  if(a != 1.0)
    return cosmoData.w0 + cosmoData.wa - cosmoData.wa*(a - 1.0)/log(a);
  else
    return cosmoData.w0;
}

double hubble_noscale(double a)
{
  return sqrt(cosmoData.OmegaM/a/a/a + cosmoData.OmegaK/a/a + cosmoData.OmegaL/pow(a,3.0*(1.0 + weff(a))));
}


/** @file */
#ifndef __CCL_UTILS_H_INCLUDED__
#define __CCL_UTILS_H_INCLUDED__

#include <gsl/gsl_spline.h>

#define CCL_MIN(a, b)  (((a) < (b)) ? (a) : (b))
#define CCL_MAX(a, b)  (((a) > (b)) ? (a) : (b))

CCL_BEGIN_DECLS

/**
 * Compute bin edges of N-1 linearly spaced bins on the interval [xmin,xmax]
 * @param xmin minimum value of spacing
 * @param xmax maximum value of spacing
 * @param N number of bins plus one (number of bin edges)
 * @return x, bin edges in range [xmin, xmax]
 */
double * ccl_linear_spacing(double xmin, double xmax, int N);

/**
 * Compute bin edges of N-1 logarithmically and then linearly spaced bins on the interval [xmin,xmax]
 * @param xminlog minimum value of spacing
 * @param xmin value when logarithmical ends and linear spacing begins
 * @param xmax maximum value of spacing
 * @param Nlin number of linear bins plus one (number of bin edges)
 * @param Nlog number of logarithmic bins plus one (number of bin edges)
 * @return x, bin edges in range [xminlog, xmax]
 */
double * ccl_linlog_spacing(double xminlog, double xmin, double xmax, int Nlin, int Nlog);

/**
 * Compute bin edges of N-1 logarithmically spaced bins on the interval [xmin,xmax]
 * @param xmin minimum value of spacing
 * @param xmax maximum value of spacing
 * @param N number of bins plus one (number of bin edges)
 * @return x, bin edges in range [xmin, xmax]
 */
double * ccl_log_spacing(double xmin, double xmax, int N);
//Returns array of N logarithmically-spaced values between xmin and xmax

double ccl_j_bessel(int l,double x);
//Spherical Bessel function of order l (adapted from CAMB)

CCL_END_DECLS

#endif


/* multimin/test_funcs.c
 *
 * Copyright (C) 1996, 1997, 1998, 1999, 2000 Fabrice Rossi
 *
 * 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.
 */

#include <config.h>
#include <gsl/gsl_multimin.h>

#include "test_funcs.h"

gsl_multimin_function_fdf rosenbrock =
{&rosenbrock_f,
 &rosenbrock_df,
 &rosenbrock_fdf,
 2, 0};

gsl_multimin_function rosenbrock_fmin =
{&rosenbrock_f,
 2, 0};

void rosenbrock_initpt (gsl_vector * x)
{
  gsl_vector_set (x, 0, -1.2);
  gsl_vector_set (x, 1, 1.0);
}

double rosenbrock_f (const gsl_vector * x, void *params)
{
  double u = gsl_vector_get(x,0);
  double v = gsl_vector_get(x,1);
  double a = u - 1;
  double b = u * u - v;
  fcount++;
  return a * a + 10 * b * b;
}

void rosenbrock_df (const gsl_vector * x, void *params, gsl_vector * df)
{
  double u = gsl_vector_get(x,0);
  double v = gsl_vector_get(x,1);
  double b = u * u - v;
  gcount++;
  gsl_vector_set(df,0,2 * (u - 1) + 40 * u * b);
  gsl_vector_set(df,1,-20 * b);
}

void rosenbrock_fdf (const gsl_vector * x, void *params, double * f,
                     gsl_vector * df)
{
  double u = gsl_vector_get(x,0);
  double v = gsl_vector_get(x,1);
  double a = u - 1;
  double b = u * u - v;
  gcount++;
  *f = a * a + 10 * b * b;
  gsl_vector_set(df,0,2 * (u - 1) + 40 * u * b);
  gsl_vector_set(df,1,-20 * b);
}

gsl_multimin_function_fdf roth =
{&roth_f,
 &roth_df,
 &roth_fdf,
 2, 0};

gsl_multimin_function roth_fmin =
{&roth_f,
 2, 0};

void roth_initpt (gsl_vector * x)
{
  gsl_vector_set (x, 0, 4.5);
  gsl_vector_set (x, 1, 3.5);
}

double roth_f (const gsl_vector * x, void *params)
{
  double u = gsl_vector_get(x,0);
  double v = gsl_vector_get(x,1);
  double a = -13.0 + u + ((5.0 - v)*v - 2.0)*v;
  double b = -29.0 + u + ((v + 1.0)*v - 14.0)*v;
  fcount++;
  return a * a + b * b;
}

void roth_df (const gsl_vector * x, void *params, gsl_vector * df)
{
  double u = gsl_vector_get(x,0);
  double v = gsl_vector_get(x,1);
  double a = -13.0 + u + ((5.0 - v)*v - 2.0)*v;
  double b = -29.0 + u + ((v + 1.0)*v - 14.0)*v;
  double c = -2 + v * (10 - 3 * v);
  double d = -14 + v * (2 + 3 * v);
  gcount++;
  gsl_vector_set(df,0,2 * a + 2 * b);
  gsl_vector_set(df,1,2 * a * c + 2 * b * d);
}

void roth_fdf (const gsl_vector * x, void *params, double * f,
               gsl_vector * df)
{
  *f = roth_f (x,params);
  roth_df(x,params,df);
}

gsl_multimin_function_fdf wood =
{&wood_f,
 &wood_df,
 &wood_fdf,
 4, 0};

gsl_multimin_function wood_fmin =
{&wood_f,
 4, 0};

void
wood_initpt (gsl_vector * x)
{
  gsl_vector_set (x, 0, -3.0);
  gsl_vector_set (x, 1, -1.0);
  gsl_vector_set (x, 2, -3.0);
  gsl_vector_set (x, 3, -1.0);
}

double wood_f (const gsl_vector * x, void *params)
{
  double u1 = gsl_vector_get(x,0);
  double u2 = gsl_vector_get(x,1);
  double u3 = gsl_vector_get(x,2);
  double u4 = gsl_vector_get(x,3);

  double t1 = u1 * u1 - u2;
  double t2 = u3 * u3 - u4;
  fcount++;
  return 100 * t1 * t1 + (1 - u1) * (1 - u1)
    + 90 * t2 * t2 + (1 - u3) * (1 - u3)
    + 10.1 * ( (1 - u2) * (1 - u2) + (1 - u4) * (1 - u4) )
    + 19.8 * (1 - u2) * (1 - u4);
}

void wood_df (const gsl_vector * x, void *params, gsl_vector * df)
{
  double u1 = gsl_vector_get(x,0);
  double u2 = gsl_vector_get(x,1);
  double u3 = gsl_vector_get(x,2);
  double u4 = gsl_vector_get(x,3);

  double t1 = u1 * u1 - u2;
  double t2 = u3 * u3 - u4;
  gcount++;
  gsl_vector_set(df,0, 400 * u1 * t1 - 2 * (1 - u1) );
  gsl_vector_set(df,1, -200 * t1 - 20.2 * (1 - u2) - 19.8 * (1 - u4) );
  gsl_vector_set(df,2, 360 * u3 * t2 - 2 * (1 - u3) );
  gsl_vector_set(df,3, -180 * t2 - 20.2 * (1 - u4) - 19.8 * (1 - u2) );

}

void wood_fdf (const gsl_vector * x, void *params, double * f, gsl_vector * df)
{
  wood_df(x,params,df);
  *f=wood_f(x,params);
}

gsl_multimin_function_fdf Nrosenbrock =
{&rosenbrock_f,
 &Nrosenbrock_df,
 &Nrosenbrock_fdf,
 2, 0};

void Nrosenbrock_df (const gsl_vector * x, void *params, gsl_vector * df)
{
  gsl_multimin_function F ;
  F.f = rosenbrock_f;
  F.params = params;
  F.n = x->size;
  gsl_multimin_diff (&F, x, df);
}

void Nrosenbrock_fdf (const gsl_vector * x, void *params, double * f,
                     gsl_vector * df)
{
  *f = rosenbrock_f (x, params);
  Nrosenbrock_df (x, params, df);
}

gsl_multimin_function_fdf Nroth =
{&roth_f,
 &Nroth_df,
 &Nroth_fdf,
 2, 0};

void Nroth_df (const gsl_vector * x, void *params, gsl_vector * df)
{
  gsl_multimin_function F ;
  F.f = roth_f;
  F.params = params;
  F.n = x->size;
  gsl_multimin_diff (&F, x, df);
}

void Nroth_fdf (const gsl_vector * x, void *params, double * f,
                     gsl_vector * df)
{
  *f = roth_f (x, params);
  Nroth_df (x, params, df);
}

gsl_multimin_function_fdf Nwood =
{&wood_f,
 &Nwood_df,
 &Nwood_fdf,
 4, 0};

void Nwood_df (const gsl_vector * x, void *params, gsl_vector * df)
{
  gsl_multimin_function F ;
  F.f = wood_f;
  F.params = params;
  F.n = x->size;
  gsl_multimin_diff (&F, x, df);
}

void Nwood_fdf (const gsl_vector * x, void *params, double * f,
                     gsl_vector * df)
{
  *f = wood_f (x, params);
  Nwood_df (x, params, df);
}


#include <stdio.h>
#include <stdlib.h>
#include <math.h>
//#include <nubspline.h>
#include <gsl/gsl_interp.h>
#include <gsl/gsl_spline.h>

extern void* xcalloc(int NumPoints, int size);

/*void eval_NUBspline_1d_d(NUBspline_1d_d * restrict spline, double x,
	double* restrict val);

void eval_NUBspline_1d_d_vg(NUBspline_1d_d * restrict spline, double x,
	double* restrict val, double* restrict grad);

void eval_NUBspline_1d_d_vgl(NUBspline_1d_d * restrict spline, double x,
	double* restrict val, double* restrict grad, double* restrict lapl);

void InterpolateWithSplines(int NumPointsToInterpolate, int NumPointsToEvaluate, double* x, double* y, double* NodalX, double* NodalY, double *func, double *NodalFunc, double* NodalDeriv)
{

	double *s = xcalloc(NumPointsToInterpolate, sizeof(double));
	double *NodalS = xcalloc(NumPointsToEvaluate, sizeof(double));
	for (int j = 0; j < NumPointsToInterpolate; j++)
	{
		s[i] = sqrt(pow(x[j]-x[0],2)+pow(y[j]-y[0],2));

	}

	for(int j = 0; j < NumPointsToEvaluate, j++)
	{
		NodalS[i] = sqrt(pow(NodalX[j] -x[0],2) + pow(NodalY[j]-y[0],2));
	}

	NUgrid* myGrid = create_general_grid(s, NumPointsToInterpolate);
	BCtype_d myBC;
	myBC.lCode = NATURAL;
	myBC.rCode = NATURAL;
	NUBspline_1d_d *mySpline = create_NUBspline_1d_d(myGrid, myBC, func);
	for(int i =0; i < NumPointsToEvaluate; i++)
	{
		if (NodalDeriv != NULL)
			eval_NUBspline_1d_d_vg(mySpline, NodalS[i], &NodalFunc[i], &NodalDeriv[i]);
		else
			eval_NUBspline_1d_d(mySpline, NodalS[i], &NodalFunc[i]);
	}

	free(s);
	free(NodalS);

}
*/

void InterpolateWithGSLSplines(int NumPointsToInterpolate, int NumPointsToEvaluate, double* x, double* y, double* NodalX, double* NodalY, double* func, double* NodalFunc, double* NodalDeriv)
{
	double *s = xcalloc(NumPointsToInterpolate, sizeof(double));
	double *NodalS = xcalloc(NumPointsToEvaluate, sizeof(double));
	for (int j = 0; j < NumPointsToInterpolate; j++)
	{
		s[j] = sqrt(pow(x[j]-x[0],2)+pow(y[j]-y[0],2));

	}

	for(int j = 0; j < NumPointsToEvaluate; j++)
	{
		NodalS[j] = sqrt(pow(NodalX[j] -x[0],2) + pow(NodalY[j]-y[0],2));
	}

	gsl_interp_accel *acc = gsl_interp_accel_alloc();
	gsl_spline* spline = gsl_spline_alloc(gsl_interp_cspline, NumPointsToInterpolate);
	gsl_spline_init(spline, s, func, NumPointsToInterpolate);

	for(int j = 0; j < NumPointsToEvaluate; j++)
	{
		NodalFunc[j] = gsl_spline_eval(spline, NodalS[j], acc);
		if (NodalDeriv != NULL)
			NodalDeriv[j] = gsl_spline_eval_deriv(spline, NodalS[j], acc);
	}

	gsl_interp_accel_free(acc);
	gsl_spline_free(spline);
	free(s);
	free(NodalS);

}


/* randist/exppow.c
 *
 * Copyright (C) 1996, 1997, 1998, 1999, 2000, 2006 James Theiler, Brian Gough
 * Copyright (C) 2006 Giulio Bottazzi
 *
 * 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.
 */

#include <config.h>
#include <math.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_sf_gamma.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_randist.h>

/* The exponential power probability distribution is

   p(x) dx = (1/(2 a Gamma(1+1/b))) * exp(-|x/a|^b) dx

   for -infty < x < infty. For b = 1 it reduces to the Laplace
   distribution.

   The exponential power distribution is related to the gamma
   distribution by E = a * pow(G(1/b),1/b), where E is an exponential
   power variate and G is a gamma variate.

   We use this relation for b < 1. For b >=1 we use rejection methods
   based on the laplace and gaussian distributions which should be
   faster.  For b>4 we revert to the gamma method.

   See P. R. Tadikamalla, "Random Sampling from the Exponential Power
   Distribution", Journal of the American Statistical Association,
   September 1980, Volume 75, Number 371, pages 683-686.

*/

double
gsl_ran_exppow (const gsl_rng * r, const double a, const double b)
{
  if (b < 1 || b > 4)
    {
      double u = gsl_rng_uniform (r);
      double v = gsl_ran_gamma (r, 1 / b, 1.0);
      double z = a * pow (v, 1 / b);

      if (u > 0.5)
        {
          return z;
        }
      else
        {
          return -z;
        }
    }
  else if (b == 1)
    {
      /* Laplace distribution */
      return gsl_ran_laplace (r, a);
    }
  else if (b < 2)
    {
      /* Use laplace distribution for rejection method, from Tadikamalla */

      double x, h, u;

      double B = pow (1 / b, 1 / b);

      do
        {
          x = gsl_ran_laplace (r, B);
          u = gsl_rng_uniform_pos (r);
          h = -pow (fabs (x), b) + fabs (x) / B - 1 + (1 / b);
        }
      while (log (u) > h);

      return a * x;
    }
  else if (b == 2)
    {
      /* Gaussian distribution */
      return gsl_ran_gaussian (r, a / sqrt (2.0));
    }
  else
    {
      /* Use gaussian for rejection method, from Tadikamalla */

      double x, h, u;

      double B = pow (1 / b, 1 / b);

      do
        {
          x = gsl_ran_gaussian (r, B);
          u = gsl_rng_uniform_pos (r);
          h = -pow (fabs (x), b) + (x * x) / (2 * B * B) + (1 / b) - 0.5;
        }
      while (log (u) > h);

      return a * x;
    }
}

double
gsl_ran_exppow_pdf (const double x, const double a, const double b)
{
  double p;
  double lngamma = gsl_sf_lngamma (1 + 1 / b);
  p = (1 / (2 * a)) * exp (-pow (fabs (x / a), b) - lngamma);
  return p;
}


/* linalg/qr.c
 *
 * Copyright (C) 1996, 1997, 1998, 1999, 2000, 2007 Gerard Jungman, 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 3 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.
 */

/* Author:  G. Jungman */

#include <config.h>
#include <stdlib.h>
#include <string.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_blas.h>

#include <gsl/gsl_linalg.h>

#include "givens.c"
#include "apply_givens.c"

/* Factorise a general M x N matrix A into
 *
 *   A = Q R
 *
 * where Q is orthogonal (M x M) and R is upper triangular (M x N).
 *
 * Q is stored as a packed set of Householder transformations in the
 * strict lower triangular part of the input matrix.
 *
 * R is stored in the diagonal and upper triangle of the input matrix.
 *
 * The full matrix for Q can be obtained as the product
 *
 *       Q = Q_k .. Q_2 Q_1
 *
 * where k = MIN(M,N) and
 *
 *       Q_i = (I - tau_i * v_i * v_i')
 *
 * and where v_i is a Householder vector
 *
 *       v_i = [1, m(i+1,i), m(i+2,i), ... , m(M,i)]
 *
 * This storage scheme is the same as in LAPACK.  */

int
gsl_linalg_QR_decomp (gsl_matrix * A, gsl_vector * tau)
{
  const size_t M = A->size1;
  const size_t N = A->size2;

  if (tau->size != GSL_MIN (M, N))
    {
      GSL_ERROR ("size of tau must be MIN(M,N)", GSL_EBADLEN);
    }
  else
    {
      size_t i;

      for (i = 0; i < GSL_MIN (M, N); i++)
        {
          /* Compute the Householder transformation to reduce the j-th
             column of the matrix to a multiple of the j-th unit vector */

          gsl_vector_view c_full = gsl_matrix_column (A, i);
          gsl_vector_view c = gsl_vector_subvector (&(c_full.vector), i, M-i);

          double tau_i = gsl_linalg_householder_transform (&(c.vector));

          gsl_vector_set (tau, i, tau_i);

          /* Apply the transformation to the remaining columns and
             update the norms */

          if (i + 1 < N)
            {
              gsl_matrix_view m = gsl_matrix_submatrix (A, i, i + 1, M - i, N - (i + 1));
              gsl_linalg_householder_hm (tau_i, &(c.vector), &(m.matrix));
            }
        }

      return GSL_SUCCESS;
    }
}

/* Solves the system A x = b using the QR factorisation,

 *  R x = Q^T b
 *
 * to obtain x. Based on SLATEC code.
 */

int
gsl_linalg_QR_solve (const gsl_matrix * QR, const gsl_vector * tau, const gsl_vector * b, gsl_vector * x)
{
  if (QR->size1 != QR->size2)
    {
      GSL_ERROR ("QR matrix must be square", GSL_ENOTSQR);
    }
  else if (QR->size1 != b->size)
    {
      GSL_ERROR ("matrix size must match b size", GSL_EBADLEN);
    }
  else if (QR->size2 != x->size)
    {
      GSL_ERROR ("matrix size must match solution size", GSL_EBADLEN);
    }
  else
    {
      /* Copy x <- b */

      gsl_vector_memcpy (x, b);

      /* Solve for x */

      gsl_linalg_QR_svx (QR, tau, x);

      return GSL_SUCCESS;
    }
}

/* Solves the system A x = b in place using the QR factorisation,

 *  R x = Q^T b
 *
 * to obtain x. Based on SLATEC code.
 */

int
gsl_linalg_QR_svx (const gsl_matrix * QR, const gsl_vector * tau, gsl_vector * x)
{

  if (QR->size1 != QR->size2)
    {
      GSL_ERROR ("QR matrix must be square", GSL_ENOTSQR);
    }
  else if (QR->size1 != x->size)
    {
      GSL_ERROR ("matrix size must match x/rhs size", GSL_EBADLEN);
    }
  else
    {
      /* compute rhs = Q^T b */

      gsl_linalg_QR_QTvec (QR, tau, x);

      /* Solve R x = rhs, storing x in-place */

      gsl_blas_dtrsv (CblasUpper, CblasNoTrans, CblasNonUnit, QR, x);

      return GSL_SUCCESS;
    }
}

/* Find the least squares solution to the overdetermined system
 *
 *   A x = b
 *
 * for M >= N using the QR factorization A = Q R.
 */

int
gsl_linalg_QR_lssolve (const gsl_matrix * QR, const gsl_vector * tau, const gsl_vector * b, gsl_vector * x, gsl_vector * residual)
{
  const size_t M = QR->size1;
  const size_t N = QR->size2;

  if (M < N)
    {
      GSL_ERROR ("QR matrix must have M>=N", GSL_EBADLEN);
    }
  else if (M != b->size)
    {
      GSL_ERROR ("matrix size must match b size", GSL_EBADLEN);
    }
  else if (N != x->size)
    {
      GSL_ERROR ("matrix size must match solution size", GSL_EBADLEN);
    }
  else if (M != residual->size)
    {
      GSL_ERROR ("matrix size must match residual size", GSL_EBADLEN);
    }
  else
    {
      gsl_matrix_const_view R = gsl_matrix_const_submatrix (QR, 0, 0, N, N);
      gsl_vector_view c = gsl_vector_subvector(residual, 0, N);

      gsl_vector_memcpy(residual, b);

      /* compute rhs = Q^T b */

      gsl_linalg_QR_QTvec (QR, tau, residual);

      /* Solve R x = rhs */

      gsl_vector_memcpy(x, &(c.vector));

      gsl_blas_dtrsv (CblasUpper, CblasNoTrans, CblasNonUnit, &(R.matrix), x);

      /* Compute residual = b - A x = Q (Q^T b - R x) */

      gsl_vector_set_zero(&(c.vector));

      gsl_linalg_QR_Qvec(QR, tau, residual);

      return GSL_SUCCESS;
    }
}

int
gsl_linalg_QR_Rsolve (const gsl_matrix * QR, const gsl_vector * b, gsl_vector * x)
{
  if (QR->size1 != QR->size2)
    {
      GSL_ERROR ("QR matrix must be square", GSL_ENOTSQR);
    }
  else if (QR->size1 != b->size)
    {
      GSL_ERROR ("matrix size must match b size", GSL_EBADLEN);
    }
  else if (QR->size2 != x->size)
    {
      GSL_ERROR ("matrix size must match x size", GSL_EBADLEN);
    }
  else
    {
      /* Copy x <- b */

      gsl_vector_memcpy (x, b);

      /* Solve R x = b, storing x in-place */

      gsl_blas_dtrsv (CblasUpper, CblasNoTrans, CblasNonUnit, QR, x);

      return GSL_SUCCESS;
    }
}

int
gsl_linalg_QR_Rsvx (const gsl_matrix * QR, gsl_vector * x)
{
  if (QR->size1 != QR->size2)
    {
      GSL_ERROR ("QR matrix must be square", GSL_ENOTSQR);
    }
  else if (QR->size1 != x->size)
    {
      GSL_ERROR ("matrix size must match rhs size", GSL_EBADLEN);
    }
  else
    {
      /* Solve R x = b, storing x in-place */

      gsl_blas_dtrsv (CblasUpper, CblasNoTrans, CblasNonUnit, QR, x);

      return GSL_SUCCESS;
    }
}

int
gsl_linalg_R_solve (const gsl_matrix * R, const gsl_vector * b, gsl_vector * x)
{
  if (R->size1 != R->size2)
    {
      GSL_ERROR ("R matrix must be square", GSL_ENOTSQR);
    }
  else if (R->size1 != b->size)
    {
      GSL_ERROR ("matrix size must match b size", GSL_EBADLEN);
    }
  else if (R->size2 != x->size)
    {
      GSL_ERROR ("matrix size must match solution size", GSL_EBADLEN);
    }
  else
    {
      /* Copy x <- b */

      gsl_vector_memcpy (x, b);

      /* Solve R x = b, storing x inplace in b */

      gsl_blas_dtrsv (CblasUpper, CblasNoTrans, CblasNonUnit, R, x);

      return GSL_SUCCESS;
    }
}

int
gsl_linalg_R_svx (const gsl_matrix * R, gsl_vector * x)
{
  if (R->size1 != R->size2)
    {
      GSL_ERROR ("R matrix must be square", GSL_ENOTSQR);
    }
  else if (R->size2 != x->size)
    {
      GSL_ERROR ("matrix size must match solution size", GSL_EBADLEN);
    }
  else
    {
      /* Solve R x = b, storing x inplace in b */

      gsl_blas_dtrsv (CblasUpper, CblasNoTrans, CblasNonUnit, R, x);

      return GSL_SUCCESS;
    }
}

/* Form the product Q^T v  from a QR factorized matrix
 */

int
gsl_linalg_QR_QTvec (const gsl_matrix * QR, const gsl_vector * tau, gsl_vector * v)
{
  const size_t M = QR->size1;
  const size_t N = QR->size2;

  if (tau->size != GSL_MIN (M, N))
    {
      GSL_ERROR ("size of tau must be MIN(M,N)", GSL_EBADLEN);
    }
  else if (v->size != M)
    {
      GSL_ERROR ("vector size must be N", GSL_EBADLEN);
    }
  else
    {
      size_t i;

      /* compute Q^T v */

      for (i = 0; i < GSL_MIN (M, N); i++)
        {
          gsl_vector_const_view c = gsl_matrix_const_column (QR, i);
          gsl_vector_const_view h = gsl_vector_const_subvector (&(c.vector), i, M - i);
          gsl_vector_view w = gsl_vector_subvector (v, i, M - i);
          double ti = gsl_vector_get (tau, i);
          gsl_linalg_householder_hv (ti, &(h.vector), &(w.vector));
        }
      return GSL_SUCCESS;
    }
}

int
gsl_linalg_QR_Qvec (const gsl_matrix * QR, const gsl_vector * tau, gsl_vector * v)
{
  const size_t M = QR->size1;
  const size_t N = QR->size2;

  if (tau->size != GSL_MIN (M, N))
    {
      GSL_ERROR ("size of tau must be MIN(M,N)", GSL_EBADLEN);
    }
  else if (v->size != M)
    {
      GSL_ERROR ("vector size must be N", GSL_EBADLEN);
    }
  else
    {
      size_t i;

      /* compute Q^T v */

      for (i = GSL_MIN (M, N); i-- > 0;)
        {
          gsl_vector_const_view c = gsl_matrix_const_column (QR, i);
          gsl_vector_const_view h = gsl_vector_const_subvector (&(c.vector),
                                                                i, M - i);
          gsl_vector_view w = gsl_vector_subvector (v, i, M - i);
          double ti = gsl_vector_get (tau, i);
          gsl_linalg_householder_hv (ti, &h.vector, &w.vector);
        }
      return GSL_SUCCESS;
    }
}

/* Form the product Q^T A  from a QR factorized matrix */

int
gsl_linalg_QR_QTmat (const gsl_matrix * QR, const gsl_vector * tau, gsl_matrix * A)
{
  const size_t M = QR->size1;
  const size_t N = QR->size2;

  if (tau->size != GSL_MIN (M, N))
    {
      GSL_ERROR ("size of tau must be MIN(M,N)", GSL_EBADLEN);
    }
  else if (A->size1 != M)
    {
      GSL_ERROR ("matrix must have M rows", GSL_EBADLEN);
    }
  else
    {
      size_t i;

      /* compute Q^T A */

      for (i = 0; i < GSL_MIN (M, N); i++)
        {
          gsl_vector_const_view c = gsl_matrix_const_column (QR, i);
          gsl_vector_const_view h = gsl_vector_const_subvector (&(c.vector), i, M - i);
          gsl_matrix_view m = gsl_matrix_submatrix(A, i, 0, M - i, A->size2);
          double ti = gsl_vector_get (tau, i);
          gsl_linalg_householder_hm (ti, &(h.vector), &(m.matrix));
        }
      return GSL_SUCCESS;
    }
}

/*  Form the orthogonal matrix Q from the packed QR matrix */

int
gsl_linalg_QR_unpack (const gsl_matrix * QR, const gsl_vector * tau, gsl_matrix * Q, gsl_matrix * R)
{
  const size_t M = QR->size1;
  const size_t N = QR->size2;

  if (Q->size1 != M || Q->size2 != M)
    {
      GSL_ERROR ("Q matrix must be M x M", GSL_ENOTSQR);
    }
  else if (R->size1 != M || R->size2 != N)
    {
      GSL_ERROR ("R matrix must be M x N", GSL_ENOTSQR);
    }
  else if (tau->size != GSL_MIN (M, N))
    {
      GSL_ERROR ("size of tau must be MIN(M,N)", GSL_EBADLEN);
    }
  else
    {
      size_t i, j;

      /* Initialize Q to the identity */

      gsl_matrix_set_identity (Q);

      for (i = GSL_MIN (M, N); i-- > 0;)
        {
          gsl_vector_const_view c = gsl_matrix_const_column (QR, i);
          gsl_vector_const_view h = gsl_vector_const_subvector (&c.vector,
                                                                i, M - i);
          gsl_matrix_view m = gsl_matrix_submatrix (Q, i, i, M - i, M - i);
          double ti = gsl_vector_get (tau, i);
          gsl_linalg_householder_hm (ti, &h.vector, &m.matrix);
        }

      /*  Form the right triangular matrix R from a packed QR matrix */

      for (i = 0; i < M; i++)
        {
          for (j = 0; j < i && j < N; j++)
            gsl_matrix_set (R, i, j, 0.0);

          for (j = i; j < N; j++)
            gsl_matrix_set (R, i, j, gsl_matrix_get (QR, i, j));
        }

      return GSL_SUCCESS;
    }
}

/* Update a QR factorisation for A= Q R ,  A' = A + u v^T,

 * Q' R' = QR + u v^T
 *       = Q (R + Q^T u v^T)
 *       = Q (R + w v^T)
 *
 * where w = Q^T u.
 *
 * Algorithm from Golub and Van Loan, "Matrix Computations", Section
 * 12.5 (Updating Matrix Factorizations, Rank-One Changes)
 */

int
gsl_linalg_QR_update (gsl_matrix * Q, gsl_matrix * R,
                      gsl_vector * w, const gsl_vector * v)
{
  const size_t M = R->size1;
  const size_t N = R->size2;

  if (Q->size1 != M || Q->size2 != M)
    {
      GSL_ERROR ("Q matrix must be M x M if R is M x N", GSL_ENOTSQR);
    }
  else if (w->size != M)
    {
      GSL_ERROR ("w must be length M if R is M x N", GSL_EBADLEN);
    }
  else if (v->size != N)
    {
      GSL_ERROR ("v must be length N if R is M x N", GSL_EBADLEN);
    }
  else
    {
      size_t j, k;
      double w0;

      /* Apply Given's rotations to reduce w to (|w|, 0, 0, ... , 0)

         J_1^T .... J_(n-1)^T w = +/- |w| e_1

         simultaneously applied to R,  H = J_1^T ... J^T_(n-1) R
         so that H is upper Hessenberg.  (12.5.2) */

      for (k = M - 1; k > 0; k--)  /* loop from k = M-1 to 1 */
        {
          double c, s;
          double wk = gsl_vector_get (w, k);
          double wkm1 = gsl_vector_get (w, k - 1);

          create_givens (wkm1, wk, &c, &s);
          apply_givens_vec (w, k - 1, k, c, s);
          apply_givens_qr (M, N, Q, R, k - 1, k, c, s);
        }

      w0 = gsl_vector_get (w, 0);

      /* Add in w v^T  (Equation 12.5.3) */

      for (j = 0; j < N; j++)
        {
          double r0j = gsl_matrix_get (R, 0, j);
          double vj = gsl_vector_get (v, j);
          gsl_matrix_set (R, 0, j, r0j + w0 * vj);
        }

      /* Apply Givens transformations R' = G_(n-1)^T ... G_1^T H
         Equation 12.5.4 */

      for (k = 1; k < GSL_MIN(M,N+1); k++)
        {
          double c, s;
          double diag = gsl_matrix_get (R, k - 1, k - 1);
          double offdiag = gsl_matrix_get (R, k, k - 1);

          create_givens (diag, offdiag, &c, &s);
          apply_givens_qr (M, N, Q, R, k - 1, k, c, s);

          gsl_matrix_set (R, k, k - 1, 0.0);    /* exact zero of G^T */
        }

      return GSL_SUCCESS;
    }
}

int
gsl_linalg_QR_QRsolve (gsl_matrix * Q, gsl_matrix * R, const gsl_vector * b, gsl_vector * x)
{
  const size_t M = R->size1;
  const size_t N = R->size2;

  if (M != N)
    {
      return GSL_ENOTSQR;
    }
  else if (Q->size1 != M || b->size != M || x->size != M)
    {
      return GSL_EBADLEN;
    }
  else
    {
      /* compute sol = Q^T b */

      gsl_blas_dgemv (CblasTrans, 1.0, Q, b, 0.0, x);

      /* Solve R x = sol, storing x in-place */

      gsl_blas_dtrsv (CblasUpper, CblasNoTrans, CblasNonUnit, R, x);

      return GSL_SUCCESS;
    }
}


/* randist/tdist.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 <math.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_sf_gamma.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_randist.h>

/* The t-distribution has the form

   p(x) dx = (Gamma((nu + 1)/2)/(sqrt(pi nu) Gamma(nu/2))
   * (1 + (x^2)/nu)^-((nu + 1)/2) dx

   The method used here is the one described in Knuth */

double
gsl_ran_tdist (const gsl_rng * r, const double nu)
{
  if (nu <= 2)
    {
      double Y1 = gsl_ran_ugaussian (r);
      double Y2 = gsl_ran_chisq (r, nu);

      double t = Y1 / sqrt (Y2 / nu);

      return t;
    }
  else
    {
      double Y1, Y2, Z, t;
      do
	{
	  Y1 = gsl_ran_ugaussian (r);
	  Y2 = gsl_ran_exponential (r, 1 / (nu/2 - 1));

	  Z = Y1 * Y1 / (nu - 2);
	}
      while (1 - Z < 0 || exp (-Y2 - Z) > (1 - Z));

      /* Note that there is a typo in Knuth's formula, the line below
	 is taken from the original paper of Marsaglia, Mathematics of
	 Computation, 34 (1980), p 234-256 */

      t = Y1 / sqrt ((1 - 2 / nu) * (1 - Z));
      return t;
    }
}

double
gsl_ran_tdist_pdf (const double x, const double nu)
{
  double p;

  double lg1 = gsl_sf_lngamma (nu / 2);
  double lg2 = gsl_sf_lngamma ((nu + 1) / 2);

  p = ((exp (lg2 - lg1) / sqrt (M_PI * nu))
       * pow ((1 + x * x / nu), -(nu + 1) / 2));
  return p;
}