/* specfunc/gsl_sf_bessel.h
 *
 * Copyright (C) 1996, 1997, 1998, 1999, 2000 Gerard Jungman
 *
 * 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 */

#ifndef __GSL_SF_BESSEL_H__
#define __GSL_SF_BESSEL_H__

#include <stdlib.h>
#include <gsl/gsl_mode.h>
#include <gsl/gsl_precision.h>
#include <gsl/gsl_sf_result.h>

#undef __BEGIN_DECLS
#undef __END_DECLS
#ifdef __cplusplus
# define __BEGIN_DECLS extern "C" {
# define __END_DECLS }
#else
# define __BEGIN_DECLS /* empty */
# define __END_DECLS /* empty */
#endif

__BEGIN_DECLS

/* Regular Bessel Function J_0(x)
 *
 * exceptions: none
 */
int gsl_sf_bessel_J0_e(const double x,  gsl_sf_result * result);
double gsl_sf_bessel_J0(const double x);

/* Regular Bessel Function J_1(x)
 *
 * exceptions: GSL_EUNDRFLW
 */
int gsl_sf_bessel_J1_e(const double x, gsl_sf_result * result);
double gsl_sf_bessel_J1(const double x);

/* Regular Bessel Function J_n(x)
 *
 * exceptions: GSL_EUNDRFLW
 */
int gsl_sf_bessel_Jn_e(int n, double x, gsl_sf_result * result);
double gsl_sf_bessel_Jn(const int n, const double x);

/* Regular Bessel Function J_n(x),  nmin <= n <= nmax
 *
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
int gsl_sf_bessel_Jn_array(int nmin, int nmax, double x, double * result_array);

/* Irregular Bessel function Y_0(x)
 *
 * x > 0.0
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
int gsl_sf_bessel_Y0_e(const double x, gsl_sf_result * result);
double gsl_sf_bessel_Y0(const double x);

/* Irregular Bessel function Y_1(x)
 *
 * x > 0.0
 * exceptions: GSL_EDOM, GSL_EOVRFLW, GSL_EUNDRFLW
 */
int gsl_sf_bessel_Y1_e(const double x, gsl_sf_result * result);
double gsl_sf_bessel_Y1(const double x);

/* Irregular Bessel function Y_n(x)
 *
 * x > 0.0
 * exceptions: GSL_EDOM, GSL_EOVRFLW, GSL_EUNDRFLW
 */
int gsl_sf_bessel_Yn_e(int n,const double x, gsl_sf_result * result);
double gsl_sf_bessel_Yn(const int n,const double x);

/* Irregular Bessel function Y_n(x), nmin <= n <= nmax
 *
 * x > 0.0
 * exceptions: GSL_EDOM, GSL_EOVRFLW, GSL_EUNDRFLW
 */
int gsl_sf_bessel_Yn_array(const int nmin, const int nmax, const double x, double * result_array);

/* Regular modified Bessel function I_0(x)
 *
 * exceptions: GSL_EOVRFLW
 */
int gsl_sf_bessel_I0_e(const double x, gsl_sf_result * result);
double gsl_sf_bessel_I0(const double x);

/* Regular modified Bessel function I_1(x)
 *
 * exceptions: GSL_EOVRFLW, GSL_EUNDRFLW
 */
int gsl_sf_bessel_I1_e(const double x, gsl_sf_result * result);
double gsl_sf_bessel_I1(const double x);

/* Regular modified Bessel function I_n(x)
 *
 * exceptions: GSL_EOVRFLW, GSL_EUNDRFLW
 */
int gsl_sf_bessel_In_e(const int n, const double x, gsl_sf_result * result);
double gsl_sf_bessel_In(const int n, const double x);

/* Regular modified Bessel function  I_n(x) for n=nmin,...,nmax
 *
 * nmin >=0, nmax >= nmin
 * exceptions: GSL_EDOM, GSL_EOVRFLW, GSL_EUNDRFLW
 */
int gsl_sf_bessel_In_array(const int nmin, const int nmax, const double x, double * result_array);

/* Scaled regular modified Bessel function
 *  exp(-|x|) I_0(x)
 *
 * exceptions: none
 */
int gsl_sf_bessel_I0_scaled_e(const double x, gsl_sf_result * result);
double gsl_sf_bessel_I0_scaled(const double x);

/* Scaled regular modified Bessel function
 *  exp(-|x|) I_1(x)
 *
 * exceptions: GSL_EUNDRFLW
 */
int gsl_sf_bessel_I1_scaled_e(const double x, gsl_sf_result * result);
double gsl_sf_bessel_I1_scaled(const double x);

/* Scaled regular modified Bessel function
 *  exp(-|x|) I_n(x)
 *
 * exceptions: GSL_EUNDRFLW
 */
int gsl_sf_bessel_In_scaled_e(int n, const double x, gsl_sf_result * result);
double gsl_sf_bessel_In_scaled(const int n, const double x);

/* Scaled regular modified Bessel function
 *  exp(-|x|) I_n(x)  for n=nmin,...,nmax
 *
 * nmin >=0, nmax >= nmin
 * exceptions: GSL_EUNDRFLW
 */
int gsl_sf_bessel_In_scaled_array(const int nmin, const int nmax, const double x, double * result_array);

/* Irregular modified Bessel function K_0(x)
 *
 * x > 0.0
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
int gsl_sf_bessel_K0_e(const double x, gsl_sf_result * result);
double gsl_sf_bessel_K0(const double x);

/* Irregular modified Bessel function K_1(x)
 *
 * x > 0.0
 * exceptions: GSL_EDOM, GSL_EOVRFLW, GSL_EUNDRFLW
 */
int gsl_sf_bessel_K1_e(const double x, gsl_sf_result * result);
double gsl_sf_bessel_K1(const double x);

/* Irregular modified Bessel function K_n(x)
 *
 * x > 0.0
 * exceptions: GSL_EDOM, GSL_EOVRFLW, GSL_EUNDRFLW
 */
int gsl_sf_bessel_Kn_e(const int n, const double x, gsl_sf_result * result);
double gsl_sf_bessel_Kn(const int n, const double x);

/* Irregular modified Bessel function  K_n(x)  for n=nmin,...,nmax
 *
 * x > 0.0, nmin >=0, nmax >= nmin
 * exceptions: GSL_EDOM, GSL_EOVRFLW, GSL_EUNDRFLW
 */
int gsl_sf_bessel_Kn_array(const int nmin, const int nmax, const double x, double * result_array);

/* Scaled irregular modified Bessel function
 *  exp(x) K_0(x)
 *
 * x > 0.0
 * exceptions: GSL_EDOM
 */
int gsl_sf_bessel_K0_scaled_e(const double x, gsl_sf_result * result);
double gsl_sf_bessel_K0_scaled(const double x);

/* Scaled irregular modified Bessel function
 *  exp(x) K_1(x)
 *
 * x > 0.0
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
int gsl_sf_bessel_K1_scaled_e(const double x, gsl_sf_result * result);
double gsl_sf_bessel_K1_scaled(const double x);

/* Scaled irregular modified Bessel function
 *  exp(x) K_n(x)
 *
 * x > 0.0
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
int gsl_sf_bessel_Kn_scaled_e(int n, const double x, gsl_sf_result * result);
double gsl_sf_bessel_Kn_scaled(const int n, const double x);

/* Scaled irregular modified Bessel function  exp(x) K_n(x)  for n=nmin,...,nmax
 *
 * x > 0.0, nmin >=0, nmax >= nmin
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
int gsl_sf_bessel_Kn_scaled_array(const int nmin, const int nmax, const double x, double * result_array);

/* Regular spherical Bessel function j_0(x) = sin(x)/x
 *
 * exceptions: none
 */
int gsl_sf_bessel_j0_e(const double x, gsl_sf_result * result);
double gsl_sf_bessel_j0(const double x);

/* Regular spherical Bessel function j_1(x) = (sin(x)/x - cos(x))/x
 *
 * exceptions: GSL_EUNDRFLW
 */
int gsl_sf_bessel_j1_e(const double x, gsl_sf_result * result);
double gsl_sf_bessel_j1(const double x);

/* Regular spherical Bessel function j_2(x) = ((3/x^2 - 1)sin(x) - 3cos(x)/x)/x
 *
 * exceptions: GSL_EUNDRFLW
 */
int gsl_sf_bessel_j2_e(const double x, gsl_sf_result * result);
double gsl_sf_bessel_j2(const double x);

/* Regular spherical Bessel function j_l(x)
 *
 * l >= 0, x >= 0.0
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
int gsl_sf_bessel_jl_e(const int l, const double x, gsl_sf_result * result);
double gsl_sf_bessel_jl(const int l, const double x);

/* Regular spherical Bessel function j_l(x) for l=0,1,...,lmax
 *
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
int gsl_sf_bessel_jl_array(const int lmax, const double x, double * result_array);

/* Regular spherical Bessel function j_l(x) for l=0,1,...,lmax
 * Uses Steed's method.
 *
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
int gsl_sf_bessel_jl_steed_array(const int lmax, const double x, double * jl_x_array);

/* Irregular spherical Bessel function y_0(x)
 *
 * exceptions: none
 */
int gsl_sf_bessel_y0_e(const double x, gsl_sf_result * result);
double gsl_sf_bessel_y0(const double x);

/* Irregular spherical Bessel function y_1(x)
 *
 * exceptions: GSL_EUNDRFLW
 */
int gsl_sf_bessel_y1_e(const double x, gsl_sf_result * result);
double gsl_sf_bessel_y1(const double x);

/* Irregular spherical Bessel function y_2(x)
 *
 * exceptions: GSL_EUNDRFLW
 */
int gsl_sf_bessel_y2_e(const double x, gsl_sf_result * result);
double gsl_sf_bessel_y2(const double x);

/* Irregular spherical Bessel function y_l(x)
 *
 * exceptions: GSL_EUNDRFLW
 */
int gsl_sf_bessel_yl_e(int l, const double x, gsl_sf_result * result);
double gsl_sf_bessel_yl(const int l, const double x);

/* Irregular spherical Bessel function y_l(x) for l=0,1,...,lmax
 *
 * exceptions: GSL_EUNDRFLW
 */
int gsl_sf_bessel_yl_array(const int lmax, const double x, double * result_array);

/* Regular scaled modified spherical Bessel function
 *
 * Exp[-|x|] i_0(x)
 *
 * exceptions: none
 */
int gsl_sf_bessel_i0_scaled_e(const double x, gsl_sf_result * result);
double gsl_sf_bessel_i0_scaled(const double x);

/* Regular scaled modified spherical Bessel function
 *
 * Exp[-|x|] i_1(x)
 *
 * exceptions: GSL_EUNDRFLW
 */
int gsl_sf_bessel_i1_scaled_e(const double x, gsl_sf_result * result);
double gsl_sf_bessel_i1_scaled(const double x);

/* Regular scaled modified spherical Bessel function
 *
 * Exp[-|x|] i_2(x)
 *
 * exceptions: GSL_EUNDRFLW
 */
int gsl_sf_bessel_i2_scaled_e(const double x, gsl_sf_result * result);
double gsl_sf_bessel_i2_scaled(const double x);

/* Regular scaled modified spherical Bessel functions
 *
 * Exp[-|x|] i_l(x)
 *
 * i_l(x) = Sqrt[Pi/(2x)] BesselI[l+1/2,x]
 *
 * l >= 0
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
int gsl_sf_bessel_il_scaled_e(const int l, double x, gsl_sf_result * result);
double gsl_sf_bessel_il_scaled(const int l, const double x);

/* Regular scaled modified spherical Bessel functions
 *
 * Exp[-|x|] i_l(x)
 * for l=0,1,...,lmax
 *
 * exceptions: GSL_EUNDRFLW
 */
int gsl_sf_bessel_il_scaled_array(const int lmax, const double x, double * result_array);

/* Irregular scaled modified spherical Bessel function
 * Exp[x] k_0(x)
 *
 * x > 0.0
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
int gsl_sf_bessel_k0_scaled_e(const double x, gsl_sf_result * result);
double gsl_sf_bessel_k0_scaled(const double x);

/* Irregular modified spherical Bessel function
 * Exp[x] k_1(x)
 *
 * x > 0.0
 * exceptions: GSL_EDOM, GSL_EUNDRFLW, GSL_EOVRFLW
 */
int gsl_sf_bessel_k1_scaled_e(const double x, gsl_sf_result * result);
double gsl_sf_bessel_k1_scaled(const double x);

/* Irregular modified spherical Bessel function
 * Exp[x] k_2(x)
 *
 * x > 0.0
 * exceptions: GSL_EDOM, GSL_EUNDRFLW, GSL_EOVRFLW
 */
int gsl_sf_bessel_k2_scaled_e(const double x, gsl_sf_result * result);
double gsl_sf_bessel_k2_scaled(const double x);

/* Irregular modified spherical Bessel function
 * Exp[x] k_l[x]
 *
 * k_l(x) = Sqrt[Pi/(2x)] BesselK[l+1/2,x]
 *
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
int gsl_sf_bessel_kl_scaled_e(int l, const double x, gsl_sf_result * result);
double gsl_sf_bessel_kl_scaled(const int l, const double x);

/* Irregular scaled modified spherical Bessel function
 * Exp[x] k_l(x)
 *
 * for l=0,1,...,lmax
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
int gsl_sf_bessel_kl_scaled_array(const int lmax, const double x, double * result_array);

/* Regular cylindrical Bessel function J_nu(x)
 *
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
int gsl_sf_bessel_Jnu_e(const double nu, const double x, gsl_sf_result * result);
double gsl_sf_bessel_Jnu(const double nu, const double x);

/* Irregular cylindrical Bessel function Y_nu(x)
 *
 * exceptions:
 */
int gsl_sf_bessel_Ynu_e(double nu, double x, gsl_sf_result * result);
double gsl_sf_bessel_Ynu(const double nu, const double x);

/* Regular cylindrical Bessel function J_nu(x)
 * evaluated at a series of x values. The array
 * contains the x values. They are assumed to be
 * strictly ordered and positive. The array is
 * over-written with the values of J_nu(x_i).
 *
 * exceptions: GSL_EDOM, GSL_EINVAL
 */
int gsl_sf_bessel_sequence_Jnu_e(double nu, gsl_mode_t mode, size_t size, double * v);

/* Scaled modified cylindrical Bessel functions
 *
 * Exp[-|x|] BesselI[nu, x]
 * x >= 0, nu >= 0
 *
 * exceptions: GSL_EDOM
 */
int gsl_sf_bessel_Inu_scaled_e(double nu, double x, gsl_sf_result * result);
double gsl_sf_bessel_Inu_scaled(double nu, double x);

/* Modified cylindrical Bessel functions
 *
 * BesselI[nu, x]
 * x >= 0, nu >= 0
 *
 * exceptions: GSL_EDOM, GSL_EOVRFLW
 */
int gsl_sf_bessel_Inu_e(double nu, double x, gsl_sf_result * result);
double gsl_sf_bessel_Inu(double nu, double x);

/* Scaled modified cylindrical Bessel functions
 *
 * Exp[+|x|] BesselK[nu, x]
 * x > 0, nu >= 0
 *
 * exceptions: GSL_EDOM
 */
int gsl_sf_bessel_Knu_scaled_e(const double nu, const double x, gsl_sf_result * result);
double gsl_sf_bessel_Knu_scaled(const double nu, const double x);

/* Modified cylindrical Bessel functions
 *
 * BesselK[nu, x]
 * x > 0, nu >= 0
 *
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
int gsl_sf_bessel_Knu_e(const double nu, const double x, gsl_sf_result * result);
double gsl_sf_bessel_Knu(const double nu, const double x);

/* Logarithm of modified cylindrical Bessel functions.
 *
 * Log[BesselK[nu, x]]
 * x > 0, nu >= 0
 *
 * exceptions: GSL_EDOM
 */
int gsl_sf_bessel_lnKnu_e(const double nu, const double x, gsl_sf_result * result);
double gsl_sf_bessel_lnKnu(const double nu, const double x);

/* s'th positive zero of the Bessel function J_0(x).
 *
 * exceptions:
 */
int gsl_sf_bessel_zero_J0_e(unsigned int s, gsl_sf_result * result);
double gsl_sf_bessel_zero_J0(unsigned int s);

/* s'th positive zero of the Bessel function J_1(x).
 *
 * exceptions:
 */
int gsl_sf_bessel_zero_J1_e(unsigned int s, gsl_sf_result * result);
double gsl_sf_bessel_zero_J1(unsigned int s);

/* s'th positive zero of the Bessel function J_nu(x).
 *
 * exceptions:
 */
int gsl_sf_bessel_zero_Jnu_e(double nu, unsigned int s, gsl_sf_result * result);
double gsl_sf_bessel_zero_Jnu(double nu, unsigned int s);

__END_DECLS

#endif /* __GSL_SF_BESSEL_H__ */


/* AUTORIGHTS
Copyright (C) 2007 Princeton University

This file is part of Ferret Toolkit.

Ferret Toolkit 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, 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 <math.h>
#ifdef _OPENMP
#include <omp.h>
#endif
#include <gsl/gsl_cdf.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_multiroots.h>
#include <cass.h>
#include "LSH.h"
#include "local.h"

#define ERR	1e-4

struct local_params
{
	double a;
	double b;
	double W;
	int M;
	int L;
	int K;
};

static inline double p_col_helper (double x)
{
	double result;
	result = 2.0*gsl_cdf_ugaussian_P(x) - 1.0;
	result += sqrt(2.0/M_PI) * (exp(-x*x/2.0)-1.0)/x;
	return result;
}

static inline double p_col (double x, double W, int M, int L)
{
	return 1.0 - pow(1.0 - pow(p_col_helper(W/x), M), L);
}

static int fun (const gsl_vector *x, void *params, gsl_vector *f)
{
	double W = ((struct local_params *)params)->W;
	int M = ((struct local_params *)params)->M;
	int L = ((struct local_params *)params)->L;
	int K = ((struct local_params *)params)->K;
	double fa = ((struct local_params *)params)->a;
	double fb = ((struct local_params *)params)->b;
	double sxx, sxy, sx, sy, k, d;
	double a, b;
	int n;

	double alpha = gsl_vector_get(x, 0);
	double beta = gsl_vector_get(x, 1);

	sxx = sxy = sx = sy = 0;

	n = 0;
	k = 0;
	while ((k < K) && (n < 1000))
	{
		double lk, ld;
		n++;
		d = alpha * pow(n, beta);
		k += p_col(sqrt(d), W, M, L);
		lk = log(k);
		ld = log(d);
		sx += lk;
		sy += ld;
		sxx += lk * lk;
		sxy += lk * ld;
	}

	least_squares(&a, &b, n, sxx, sxy, sx, sy);

	a = exp(a);

	gsl_vector_set(f, 0, a - fa);
	gsl_vector_set(f, 1, b - fb);
	return GSL_SUCCESS;
}

int print_state (size_t iter, gsl_multiroot_fsolver *s)
{
	fprintf(stderr, "iter = %3zu x = %.3f %.3f "
		"f(x) = %.3e %.3e\n",
		iter,
		gsl_vector_get(s->x, 0),
		gsl_vector_get(s->x, 1),
		gsl_vector_get(s->f, 0),
		gsl_vector_get(s->f, 1));
	return 0;
}

int localdim (double a, double b, double *alpha, double *beta, double W, int M, int L, int K)
{
	const gsl_multiroot_fsolver_type *T = NULL;
	gsl_multiroot_fsolver *s = NULL;

	int status;
	size_t iter = 0;

	struct local_params params = {.a = a, .b = b, .W = W, .M = M, .L = L, .K = K};
	gsl_multiroot_function f = {&fun, 2, &params};

	gsl_vector *x = gsl_vector_alloc(2);
	gsl_vector_set(x, 0, a);
	gsl_vector_set(x, 1, b);

	if (s == NULL)
	{
		T = gsl_multiroot_fsolver_hybrids;
		s = gsl_multiroot_fsolver_alloc(T, 2);
	}

	gsl_multiroot_fsolver_set(s, &f, x);

	do
	{
		status = gsl_multiroot_fsolver_iterate(s);

//		print_state(iter, s);

		if (status) break;

		status = gsl_multiroot_test_residual(s->f, ERR);
		iter++;
	} while ((status == GSL_CONTINUE) && (iter < 1000));

//	fprintf(stderr, "status = %s\n", gsl_strerror(status));
	*alpha = gsl_vector_get(s->x, 0);
	*beta = gsl_vector_get(s->x, 1);

	gsl_multiroot_fsolver_free(s);
	gsl_vector_free(x);
	return 0;
}

int LSH_est_init (LSH_est_t *est, int a_step, double a_min, double a_max,
				int b_step, double b_min, double b_max, double W, int M, int L, int K)
{
	double a_delta, b_delta;
	int i, j;
	est->a_step = a_step;
	est->b_step = b_step;
	est->a_min = a_min;
	est->b_min = b_min;
	est->a_max = a_max;
	est->b_max = b_max;
	a_delta = est->a_delta = (a_max - a_min) / a_step;
	b_delta = est->b_delta = (b_max - b_min) / b_step;
	est->a_table = type_matrix_alloc(double , a_step, b_step);
	est->b_table = type_matrix_alloc(double , a_step, b_step);

	for (i = 0; i < a_step; i++)
	{
		for (j = 0; j < b_step; j++)
		{
			localdim(a_min + i * a_delta,
				b_min + j * b_delta,
				&est->a_table[i][j],
				&est->b_table[i][j],
				W, M, L, K);
		}
	}

	return 0;
}


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

/* Author:  G. Jungman */

#include <config.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_sf_bessel.h>

#define DYDX_p(p,u,x) (-(p)/(x) + (((nu)*(nu))/((x)*(x))-1.0)*(u))
#define DYDX_u(p,u,x) (p)

static int
rk_step(double nu, double x, double dx, double * Jp, double * J)
{
  double p_0 = *Jp;
  double u_0 = *J;

  double p_1 = dx * DYDX_p(p_0, u_0, x);
  double u_1 = dx * DYDX_u(p_0, u_0, x);

  double p_2 = dx * DYDX_p(p_0 + 0.5*p_1, u_0 + 0.5*u_1, x + 0.5*dx);
  double u_2 = dx * DYDX_u(p_0 + 0.5*p_1, u_0 + 0.5*u_1, x + 0.5*dx);

  double p_3 = dx * DYDX_p(p_0 + 0.5*p_2, u_0 + 0.5*u_2, x + 0.5*dx);
  double u_3 = dx * DYDX_u(p_0 + 0.5*p_2, u_0 + 0.5*u_2, x + 0.5*dx);

  double p_4 = dx * DYDX_p(p_0 + p_3, u_0 + u_3, x + dx);
  double u_4 = dx * DYDX_u(p_0 + p_3, u_0 + u_3, x + dx);

  *Jp = p_0 + p_1/6.0 + p_2/3.0 + p_3/3.0 + p_4/6.0;
  *J  = u_0 + u_1/6.0 + u_2/3.0 + u_3/3.0 + u_4/6.0;

  return GSL_SUCCESS;
}

int
gsl_sf_bessel_sequence_Jnu_e(double nu, gsl_mode_t mode, size_t size, double * v)
{
  /* CHECK_POINTER(v) */

  if(nu < 0.0) {
    GSL_ERROR ("domain error", GSL_EDOM);
  }
  else if(size == 0) {
    GSL_ERROR ("error", GSL_EINVAL);
  }
  else {
    const gsl_prec_t goal   = GSL_MODE_PREC(mode);
    const double dx_array[] = { 0.001, 0.03, 0.1 }; /* double, single, approx */
    const double dx_nominal = dx_array[goal];

    const int cnu = (int) ceil(nu);
    const double nu13 = pow(nu,1.0/3.0);
    const double smalls[] = { 0.01, 0.02, 0.4, 0.7, 1.3, 2.0, 2.5, 3.2, 3.5, 4.5, 6.0 };
    const double x_small = ( nu >= 10.0 ? nu - nu13 : smalls[cnu] );

    gsl_sf_result J0, J1;
    double Jp, J;
    double x;
    size_t i = 0;

    /* Calculate the first point. */
    x = v[0];
    gsl_sf_bessel_Jnu_e(nu, x, &J0);
    v[0] = J0.val;
    ++i;

    /* Step over the idiot case where the
     * first point was actually zero.
     */
    if(x == 0.0) {
      if(v[1] <= x) {
        /* Strict ordering failure. */
        GSL_ERROR ("error", GSL_EFAILED);
      }
      x = v[1];
      gsl_sf_bessel_Jnu_e(nu, x, &J0);
      v[1] = J0.val;
      ++i;
    }

    /* Calculate directly as long as the argument
     * is small. This is necessary because the
     * integration is not very good there.
     */
    while(v[i] < x_small && i < size) {
      if(v[i] <= x) {
        /* Strict ordering failure. */
        GSL_ERROR ("error", GSL_EFAILED);
      }
      x = v[i];
      gsl_sf_bessel_Jnu_e(nu, x, &J0);
      v[i] = J0.val;
      ++i;
    }

    /* At this point we are ready to integrate.
     * The value of x is the last calculated
     * point, which has the value J0; v[i] is
     * the next point we need to calculate. We
     * calculate nu+1 at x as well to get
     * the derivative, then we go forward.
     */
    gsl_sf_bessel_Jnu_e(nu+1.0, x, &J1);
    J  = J0.val;
    Jp = -J1.val + nu/x * J0.val;

    while(i < size) {
      const double dv = v[i] - x;
      const int Nd    = (int) ceil(dv/dx_nominal);
      const double dx = dv / Nd;
      double xj;
      int j;

      if(v[i] <= x) {
        /* Strict ordering failure. */
        GSL_ERROR ("error", GSL_EFAILED);
      }

      /* Integrate over interval up to next sample point.
       */
      for(j=0, xj=x; j<Nd; j++, xj += dx) {
        rk_step(nu, xj, dx, &Jp, &J);
      }

      /* Go to next interval. */
      x = v[i];
      v[i] = J;
      ++i;
    }

    return GSL_SUCCESS;
  }
}


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

#include <gsl/gsl_blas.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_sf_pow_int.h>
#include <gsl/gsl_vector.h>

#include <argtable2.h>

#include "qdm.h"

void
qdm_ispline_vector(
    gsl_vector *result,
    const double tau,
    const size_t spline_df,
    const gsl_vector *knots
)
{
  size_t bin = qdm_vector_search(knots, tau);

  gsl_vector_set(result, 0, 1);

  for (size_t m = 0; m < result->size - 1; m++) {
    double v;

    if (bin < m) {
      v = 0;
    } else if (bin - spline_df + 1 > m) {
      v = 1;
    } else if (bin == m) {
      double n = gsl_sf_pow_int(tau - gsl_vector_get(knots, m), 3);
      double d1 = gsl_vector_get(knots, m + 3) - gsl_vector_get(knots, m);
      double d2 = gsl_vector_get(knots, m + 2) - gsl_vector_get(knots, m);
      double d3 = gsl_vector_get(knots, m + 1) - gsl_vector_get(knots, m);

      v = n / (d1 * d2 * d3);
    } else if (bin == m + 1) {
      double i1n = 3 * tau;
      double i1d = gsl_vector_get(knots, m + 2) - gsl_vector_get(knots, m + 1);
      double i1 = i1n / i1d;

      double i2n = -gsl_sf_pow_int(tau - gsl_vector_get(knots, m), 3);
      double i2d1 = gsl_vector_get(knots, m + 3) - gsl_vector_get(knots, m);
      double i2d2 = gsl_vector_get(knots, m + 2) - gsl_vector_get(knots, m);
      double i2d3 = gsl_vector_get(knots, m + 2) - gsl_vector_get(knots, m + 1);
      double i2 = i2n / (i2d1 * i2d2 * i2d3);

      double i3n = gsl_sf_pow_int(gsl_vector_get(knots, m + 3) - tau, 3);
      double i3d1 = gsl_vector_get(knots, m + 3) - gsl_vector_get(knots, m + 1);
      double i3d2 = gsl_vector_get(knots, m + 3) - gsl_vector_get(knots, m);
      double i3d3 = gsl_vector_get(knots, m + 2) - gsl_vector_get(knots, m + 1);
      double i3 = i3n / (i3d1 * i3d2 * i3d3);

      double i4an = -3 * gsl_vector_get(knots, m + 1);
      double i4ad = gsl_vector_get(knots, m + 2) - gsl_vector_get(knots, m + 1);
      double i4a = i4an / i4ad;
      double i4bn = gsl_sf_pow_int(gsl_vector_get(knots, m + 1) - gsl_vector_get(knots, m), 3);
      double i4bd1 = gsl_vector_get(knots, m + 3) - gsl_vector_get(knots, m);
      double i4bd2 = gsl_vector_get(knots, m + 2) - gsl_vector_get(knots, m);
      double i4bd3 = gsl_vector_get(knots, m + 2) - gsl_vector_get(knots, m + 1);
      double i4b = i4bn / (i4bd1 * i4bd2 * i4bd3);
      double i4cn = gsl_sf_pow_int(gsl_vector_get(knots, m + 3) - gsl_vector_get(knots, m + 1), 3);
      double i4cd1 = gsl_vector_get(knots, m + 3) - gsl_vector_get(knots, m + 1);
      double i4cd2 = gsl_vector_get(knots, m + 3) - gsl_vector_get(knots, m);
      double i4cd3 = gsl_vector_get(knots, m + 2) - gsl_vector_get(knots, m + 1);
      double i4c = i4cn / (i4cd1 * i4cd2 * i4cd3);
      double i4 = i4a + i4b - i4c;

      double i5 = 0;
      if (m != 1) {
        double i5n = gsl_sf_pow_int(gsl_vector_get(knots, m + 1) - gsl_vector_get(knots, m), 3);
        double i5d1 = gsl_vector_get(knots, m + 3) - gsl_vector_get(knots, m);
        double i5d2 = gsl_vector_get(knots, m + 2) - gsl_vector_get(knots, m);
        double i5d3 = gsl_vector_get(knots, m + 1) - gsl_vector_get(knots, m);
        i5 = i5n / (i5d1 * i5d2 * i5d3);
      }

      v = i1 + i2 + i3 + i4 + i5;
    } else {
      double n = gsl_sf_pow_int(gsl_vector_get(knots, m + 3) - tau, 3);
      double d1 = gsl_vector_get(knots, m + 3) - gsl_vector_get(knots, m);
      double d2 = gsl_vector_get(knots, m + 3) - gsl_vector_get(knots, m + 1);
      double d3 = gsl_vector_get(knots, m + 3) - gsl_vector_get(knots, m + 2);
      double d = d1 * d2 * d3;

      v = 1 - n / d;
    }

    gsl_vector_set(result, m + 1, v);
  }
}

void
qdm_ispline_matrix(
    gsl_matrix *result,
    const gsl_vector *taus,
    const size_t spline_df,
    const gsl_vector *knots
)
{
  for (size_t i = 0; i < result->size1; i++) {
    gsl_vector_view row = gsl_matrix_row(result, i);
    qdm_ispline_vector(&row.vector, gsl_vector_get(taus, i), spline_df, knots);
  }
}


/*******************************************/
/* libScalar:  -lm                         */
/*             -lIO                        */
/*                                         */
/* Scalar Arithmetic Operations and Macros */
/*                                         */
/* Nov 11 1999 Ju Li <liju99@mit.edu>      */
/*******************************************/

#ifndef _Scalar_h
#define _Scalar_h

#include <math.h>
#include <time.h>
#include <IO.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_spline.h>

/** Mathematical Constants **/

#define HALF      (0.5)
#define THIRD     (1./3.)
#define FOURTH    (0.25)
#define FIFTH     (0.2)
#define SIXTH     (1./6.)
#define SEVENTH   (1./7.)
#define EIGHTH    (0.125)
#define NINTH     (1./9.)
#define TENTH     (1./10.)
#define ELEVENTH  (1./11.)
#define TWELFTH   (1./12.)

/* extended precision to 60 digits: see Notes/mathconst.mws */
#define SQRT2 (1.41421356237309504880168872420969807856967187537694807317668)
#define SQRT3 (1.73205080756887729352744634150587236694280525381038062805581)
#define SQRT5 (2.23606797749978969640917366873127623544061835961152572427090)
#define SQRT6 (2.44948974278317809819728407470589139196594748065667012843269)
#define SQRT7 (2.64575131106459059050161575363926042571025918308245018036833)
#define SQRT8 (2.82842712474619009760337744841939615713934375075389614635336)
#define CBRT2 (1.25992104989487316476721060727822835057025146470150798008198)
#define CBRT3 (1.44224957030740838232163831078010958839186925349935057754642)
#define CBRT4 (1.58740105196819947475170563927230826039149332789985300980829)
#define CBRT5 (1.70997594667669698935310887254386010986805511054305492438286)
#define CBRT6 (1.81712059283213965889121175632726050242821046314121967148133)
#define CBRT7 (1.91293118277238910119911683954876028286243905034587576621065)
#define CBRT9 (2.08008382305190411453005682435788538633780534037326210969759)
/* (-1+sqrt(5.))/2 */
#define GOLDEN_RATIO \
  (.618033988749894848204586834365638117720309179805762862135450)
#define GOLDEN_RATIO_RECIPROCAL (GOLDEN_RATIO + 1)

#ifndef PI
#define PI    (3.14159265358979323846264338327950288419716939937510582097494)
#endif
#define RADIAN_TO_DEGREE(r) ((r)/PI*180.)
#define DEGREE_TO_RADIAN(d) ((d)/180.*PI)

#define SIN(x) sin(DEGREE_TO_RADIAN(x))
#define COS(x) cos(DEGREE_TO_RADIAN(x))
#define TAN(x) tan(DEGREE_TO_RADIAN(x))
#define ASIN(x) RADIAN_TO_DEGREE(asin(x))
#define ACOS(x) RADIAN_TO_DEGREE(acos(x))
#define ATAN(x) RADIAN_TO_DEGREE(atan(x))

#ifndef EPS
/* IEEE 754 floating-point arithmetic relative error bound */
#define EPS (2.220446e-16)
#endif

/* Deemed reasonably large number of floating point operations */
#ifndef REASONABLE_FLOPS
#define REASONABLE_FLOPS (1000)
#endif
/* on variables to estimate their likely numerical relative error */

/* When the condition number gets bad, for instance if subtracting */
/* two close numbers, we should override the above to larger value */

#ifndef TINY /* as compared to unity */
#define TINY (REASONABLE_FLOPS*EPS)
#endif

#ifndef HUGE /* as compared to unity */
#define HUGE (1./TINY)
#endif

#ifndef HUGE_INT
#define HUGE_INT (INT_MAX/2)
#endif

/* Close to the floating-point overflow */
/* IEEE 754 32-bit floating-point standard: 1.175494e-38 to 3.402823e38 */
#define SINGLE_PRECISION_INFINITY (1e37)
/* IEEE 754 64-bit floating-point standard: 2.225074e-308 to 1.797693e308 */
#define DOUBLE_PRECISION_INFINITY (1e307)

#ifndef SMALL /* as compared to unity */
#define SMALL (sqrt(EPS))
#endif

#ifndef LARGE /* as compared to unity */
 #define LARGE (1./SMALL)
#endif

/* a wise choice for estimating quadratic curvature */
#ifndef DELTA /* as compared to unity */
#define DELTA (sqrt(sqrt(EPS)))
#endif

/* very large exponent for later purposes of defining inf-norm, etc. */
#ifndef EXPONENT_INFINITY
#define EXPONENT_INFINITY (16.)
#endif

#define EQ(x,y)  ( (x) == (y) )
#define GE(x,y)  ( (x) >= (y) )
#define GT(x,y)  ( (x) >  (y) )
#define LE(x,y)  ( (x) <= (y) )
#define LT(x,y)  ( (x) <  (y) )
/* x = [lower_bound, upper_bound] */
#define XIN(x,lower_bound,upper_bound) (GE(x,lower_bound) && LE(x,upper_bound))
#define XINW(x,width) XIN(x,0.,width)
/* more likely to overflow than underflow, I think */
#define XOU(x,lower_bound,upper_bound) (GT(x,upper_bound) || LT(x,lower_bound))
#define XOUW(x,width) XOU(x,0.,width)
/* with no assumption about which is bigger, bound1 or bound2 */
#define INSIDE(x,bound1,bound2) (XIN(x,bound1,bound2) || XIN(x,bound2,bound1))
#define OUSIDE(x,bound1,bound2) (XOU(x,bound1,bound2) && XOU(x,bound2,bound1))
/* i = [lower_bound, upper_bound) */
#define IN(i,lower_bound,upper_bound) (GE(i,lower_bound) && LT(i,upper_bound))
#define INW(i,n) IN(i,0,n)  /* i = 0..n-1, C convention */
#define OU(i,lower_bound,upper_bound) (GE(i,upper_bound) || LT(i,lower_bound))
#define OUW(i,n) OU(i,0,n)

#define ABS(x)  ((x)>0?(x):-(x))
#define ABS_LE(x,positive_bound) XIN(x,-(positive_bound),(positive_bound))
#define ABS_GT(x,positive_bound) XOU(x,-(positive_bound),(positive_bound))
#define ABS_LT(x,positive_bound) \
  (GT(x,-(positive_bound)) && LT(x,(positive_bound)))
#define ABS_GE(x,positive_bound) \
  (GE(x,(positive_bound)) || LE(x,-(positive_bound)))

#ifndef MIN
#define MIN(x,y)      ((x)<(y)?(x):(y))
#endif
#ifndef MAX
#define MAX(x,y)      ((x)>(y)?(x):(y))
#endif
#define SWAP(x,y,tmp) ((tmp)=(x), (x)=(y), (y)=(tmp))
#define SWITCH(p,q,state0,state1) CAN ( if ((p) == (state0)) \
  { (p)=(state1); (q)=(state0); } else { (p)=(state0); (q)=(state1); } )
#define SWITCHSTATE(p,q,state) SWITCH(p,q,state,(state)+1)
#define ENSURE(min,max,tmp) { if (min>max) SWAP(min,max,tmp); }
#define FIND3(x0,x1,x2,op,xm) CAN( xm = x0; \
  if (xm op x1) xm = x1; if (xm op x2) xm = x2 )
#define FIND4(x0,x1,x2,x3,op,xm) CAN( xm = x0; \
  if (xm op x1) xm = x1; if (xm op x2) xm = x2; if (xm op x3) xm = x3 )
#define BEPOSITIVE(x)       CAN( if ((x) < 0) x = -(x) )
#define SQUARE(i)     ((i)*(i))
#define CUBE(i)       ((i)*(i)*(i))
#define QUAD(i)       ((i)*(i)*(i)*(i))
#define CEIL(i,j)     (((i)<=0)?0:((i)-1)/(j)+1)
#define SEIL(i,j)     ((size_t)CEIL(i,j))
#define ROUNDUP_TO(i,j)         (CEIL(i,j)*(j))
#define SEPARATION(x,y)         (fabs((x)-(y)))
#define SMALLSEPARATION(x,y,z)  (fabs((x)-(y))<z)

#define SPHERE_VOLUME(radius) (4.*PI/3.*CUBE(radius))
#define safe_avg(sum,count) ((double)(sum)/(((count)!=0)?(count):1))

#define NONEED_TRIM(x)  ( ((x) >= 0.) && ((x) <  1.) )
#define NEED_TRIM(x)    ( ((x) <  0.) || ((x) >= 1.) )
#define Trim(x) { if ((x)<0) do (x)++; while((x)<0); else \
  if ((x)>=1) do (x)--; while ((x)>=1); }
/* faster than TRIM(x) when x is around 1 */
#define TRIM(x) ((x)-floor((double)(x)))  /* x's image on [0,1) */
/* faster than Trim(x) when x is very large */

#define NONEED_IMAGE(x)  ( ((x) >= -0.5) && ((x) <  0.5) )
#define NEED_IMAGE(x)    ( ((x) <  -0.5) || ((x) >= 0.5) )
#define Image(x) { if ((x)<-0.5) do (x)++; while((x)<-0.5); else \
  if ((x)>=0.5) do (x)--; while ((x)>=0.5); }
/* faster than IMAGE(x) when x is around 1 */
#define IMAGE(x)  (TRIM(x+0.5)-0.5) /* x's image on [-0.5,0.5) */
/* faster than Image(x) when x is very large */

#define DISTANCE2(x,y,z) (SQUARE(x)+SQUARE(y)+SQUARE(z))
#define DISTANCE(x,y,z)   sqrt(DISTANCE2(x,y,z))
#define DISTANCED2(x,y)  (SQUARE(x)+SQUARE(y))
#define DISTANCE2D(x,y)   sqrt(DISTANCED2(x,y))

/* b^2 = c^2 - a^2:  the answer b will be nonnegative */
#define SafePythagorasComplement(c,a)                   \
    ( (c)>fabs(a) ? sqrt(SQUARE(c)-SQUARE(a)) : 0 )

/* x is floating-point */
#define Floor(x) (((x)==(int)(x))?(int)(x):(((x)>0)?((int)(x)):((int)(x)-1)))
#define FLOOR(x,i) { (i)=(int)(x); if ((i)>(x)) (i)--; }

#if defined(_alpha)
/* Compaq C warns about negative shifts which cannot actually happen */
#define SAFE_RSHIFT(a,n)  ( ((n)>=0) ? ((a)>>ABS(n)) : ((a)<<ABS(n)) )
#define SAFE_LSHIFT(a,n)  ( ((n)>=0) ? ((a)<<ABS(n)) : ((a)>>ABS(n)) )
#else
#define SAFE_RSHIFT(a,n)  ( ((n)>=0) ? ((a)>>(n)) : ((a)<<(-(n))) )
#define SAFE_LSHIFT(a,n)  ( ((n)>=0) ? ((a)<<(n)) : ((a)>>(-(n))) )
#endif

/* x, target can now be of any numeric type */
#define ERR(x,target) Ferr((double)(x), (double)(target))

#define ISTINY(a) (fabs(a)<TINY)
#define NOTTINY(a) (fabs(a)>=TINY)
#define ISSMALL(a) (fabs(a)<SMALL)
#define NOTSMALL(a) (fabs(a)>=SMALL)
#define ISDELTA(a) (fabs(a)<DELTA)
#define NOTDELTA(a) (fabs(a)>=DELTA)
#define NEAR(x,y)    ISTINY((x)-(y))
#define NOTNEAR(x,y) NOTTINY((x)-(y))

/* whether x and y are equal to floating point accuracy */
#define EQUAL(x,y) ((fabs((double)(x-y))<TINY) || (fabs(ERR(x,y))<TINY))

/* If a number is tiny, set it to zero. USE WITH CARE! */
#define SET_ZERO_IF_TINY(a) { if ISTINY(a) (a)=0.; }

/* Genesis of all randomness */
#define DEFAULT_RANDOM_SEED (1975425) /* for marking and reproducing results */

/* randomizing subsequent Frandom() sequence with seed */
#define Randomize(seed) srandom((unsigned int)(seed))
/* if never called, Frandom() automatically uses seed 1 */
#define TimeRandomize() Randomize(time((time_t *)NULL))

#ifdef _Linux
#define Frandom() ((double)(random()+0.5)/(1.+RAND_MAX))
#define FRANDOM() ((double)(random()+0.5)/(1.+RAND_MAX)-0.5)
#else
#define Frandom() ((double)(random()+0.5)/pow(2.,31.))
#define FRANDOM() ((double)(random()+0.5)/pow(2.,31.)-0.5)
#endif
/* Genesis of all randomness */

#define HALF_DECISION() (Frandom() > 0.5)

/* randomly pick an integer in min..max (set {min,min+1... max}) */
#define Fran(min,max) (INT(min)+(int)floor((INT(max)-INT(min)+1)*Frandom()))
/* randomly pick an integer in min..max-1 (set {min,min+1... max-1}) */
#define fran(min,max) (INT(min)+(int)floor((INT(max)-INT(min))*Frandom()))

/* return normally distributed random number with <x>=E, <(x-E)^2>=sigma2 */
#define Frandnorm(E,sigma2) \
(sqrt(-2.*log(Frandom()))*sin(2*acos(-1.)*Frandom())*sqrt((double)sigma2)+E)
/* The above is not most efficient. For array assignment, use Vfrandnorm() */

/* return normally distributed random number with <x>=0, <x^2>=1 */
#define FRANDNORM() (sqrt(-2.*log(Frandom()))*sin(2*acos(-1.)*Frandom()))

/* return exponentially distributed random number with <x>=tau */
#define Frandexp(tau) (-log(Frandom())*(tau))

/* return exponentially distributed random number with <x>=1 */
#define FRANDEXP() (-log(Frandom()))

/* if a is an integer factor of b */
#define isfactor(a,b) (((int)(b))%((int)(a))==0)
#define isnotfactor(a,b) (((int)(b))%((int)(a))!=0)

/* f(x) := x * Heaviside(x) */
#define ZERO_RAMP(x) (((x)>0)?(x):0)

/** Scalar.c: **/

/* greatest common divisor of a and b */
long gcd (long a, long b);
#define GCD(a,b)  gcd((long)(a),(long)(b))
/* least common multiple */
#define LCM(a,b) (long)(a)*(b)/gcd((long)(a),(long)(b))
/* check if a is a factor of b */
#define ISFACTOR(a,b) (((long)(b))%((long)(a))==0)
#define ISEVEN(a) (((unsigned int)(a)&1)==0)
#define ISODD(a)  (((unsigned int)(a)&1))

/* find k,l such that k * x + l * y = gcd(x,y) */
void diophantine2 (int x, int y, int *k, int *l);

/* set Bitmap "b", starting from the bit "offset", every "period" */
/* bits to the lowest "period" bits of "value", for "n" periods.  */
Bmap *Bperiod (Bmap *b, int offset, int n, int period, int value);

/* relative error of x compared to target */
#define rerr(x,target) ((x)/(target)-1)
double Ferr(double x, double target);

/* calculates |_ a/b _| with mathematically correct floor */
int floorDiv (int a, int b);

/* calculates |^ a/b ^| with mathamatically correct ceiling */
int ceilDiv (int a,int b);

/* return (n!) = GAMMA(n+1) in double precision */
double factorial (int n);

/* Take average on structures whose first element is the counter  */
#define avg_what(type,s)  (sizeof(type)/sizeof(double)),((double *)(s))
#define Avg_what(type,s)  (sizeof(type)/sizeof(double)),((double *)(&(s)))
void avg_clear (int n, double *s);
int avg_add (int n, double *s, ...);
int avg_done (int n, double *s);
int avg_recover (int n, double *s);
/* to avoid alignment trouble please define the counter as double */

/* Generate a string of n-1 random base64 characters ended by EOS. */
char *RandomBase64String (int n, char *a);

/* (-1)%3=-1, but positive_remainder(-1,3)=2 */
int positive_remainder(int a, int b);

/* quadrature.c: */

/* Integration of one-dimensional function: */

/* Gaussian quadrature with W(x)=1, N=10, NR pp.148 */
double qgaus (double (*func)(double), double a, double b);

/* Romberg quadrature: */
#define QROMB_JMAX               20
#define QROMB_K                  5
#define QROMB_DEFAULT_TOLERANCE  1e-14
extern double qromb_tolerance;
double qromb (double (*func)(double), double a, double b);

/* newtonian.c: */

/************************************************************/
/* K-evaluation Integration of Newtonian Dynamics:          */
/*                                                          */
/* Given x(0),dotx(0) and routine ddotx(x) which is derived */
/* from a potential, we want to get x(h),dotx(h) where h is */
/* called a full step, during which K calls to ddotx(x) are */
/* made. Let g = h / K. For a scheme to be competitive, it  */
/* should give better results at t_f = Lh >> h compared to  */
/* other schemes with equal g, for some g/accuracy choices. */
/*                                                          */
/* Algorithms with so-called FSAL property can combine two  */
/* consecutive h-steps to save one evaluation. We provide   */
/* _start, _fsal, _stop routines where _start and _fsal     */
/* need K evaluations and _stop may need one. For complete- */
/* ness, we also give _nofsal which needs K+1 evaluations.  */
/************************************************************/

/* k=0..K-1 (some _nofsal/_stop call k=K), n, x[n], acc[n]=workspace */
typedef void (*Newtonian_ddotx) (int, int, double *, double *);

/***************************/
/* Symplectic Algorithm 1: */
/***************************/
/* First x, then dotx evolution. No great need to use FSAL savings. */

/* This algorithm is not the best for heat current computation or */
/* total energy checksum because when ddotx() is called at k=0, x */
/* is already shifted. Ruth83, Schlier98_6a, Tsitouras99.         */

/****************************************************/
/* Computer "Experiments" on Classical Fluids. I.   */
/* Thermodynamical Properties of Lennard-Jones      */
/* Molecules, L. Verlet, Phys. Rev. 159, 98 (1967). */
/* A Canonical Integration Technique, R.D. Ruth,    */
/* IEEE Trans. Nucl. Sci. NS-30, 2669 (1983).       */
/****************************************************/
/* evaluations per h-step:  1   */
/* global truncation error: h^2 */

/* First x, then dotx evolution. No great need to use FSAL savings. */
void symplectic_Ruth83_nofsal
(double h, int n, double *x, double *dotx, double *acc,
 Newtonian_ddotx ddotx);

/* FSAL sequence: _start, _fsal, _stop */
void symplectic_Ruth83_start
(double h, int n, double *x, double *dotx, double *acc,
 Newtonian_ddotx ddotx);
void symplectic_Ruth83_fsal
(double h, int n, double *x, double *dotx, double *acc,
 Newtonian_ddotx ddotx);
void symplectic_Ruth83_stop
(double h, int n, double *x, double *dotx, double *acc,
 Newtonian_ddotx ddotx);

/**************************************************************/
/* Ch. Schlier and A. Seiter, J. Phys. Chem. 102 (1998) 9399. */
/**************************************************************/
/* evaluations per h-step:  9   */
/* global truncation error: h^6 */

/* First x, then dotx evolution. No great need to use FSAL savings. */
void symplectic_Schlier98_6a_nofsal
(double h, int n, double *x, double *dotx, double *acc,
 Newtonian_ddotx ddotx);

/* FSAL sequence: _start, _fsal, _stop */
void symplectic_Schlier98_6a_start
(double h, int n, double *x, double *dotx, double *acc,
 Newtonian_ddotx ddotx);
void symplectic_Schlier98_6a_fsal
(double h, int n, double *x, double *dotx, double *acc,
 Newtonian_ddotx ddotx);
void symplectic_Schlier98_6a_stop
(double h, int n, double *x, double *dotx, double *acc,
 Newtonian_ddotx ddotx);

/************************************************************/
/* Haruo Yoshida, Phys. Lett. A 150, 262 (1990).            */
/* Celestial Mechanics and Dynamical Astronomy 74 (1999)    */
/* 223-230, Ch. Tsitouras,                                  */
/* www.math.ntua.gr/people/tsitoura/publications.html       */
/************************************************************/
/* evaluations per h-step:  33   */
/* global truncation error: h^10 */

/* First x, then dotx evolution. No great need to use FSAL savings. */
void symplectic_Tsitouras99_nofsal
(double h, int n, double *x, double *dotx, double *acc,
 Newtonian_ddotx ddotx);

/* FSAL sequence: _start, _fsal, _stop */
void symplectic_Tsitouras99_start
(double h, int n, double *x, double *dotx, double *acc,
 Newtonian_ddotx ddotx);
void symplectic_Tsitouras99_fsal
(double h, int n, double *x, double *dotx, double *acc,
 Newtonian_ddotx ddotx);
void symplectic_Tsitouras99_stop
(double h, int n, double *x, double *dotx, double *acc,
 Newtonian_ddotx ddotx);

/***************************/
/* Symplectic Algorithm 2: */
/***************************/
/* First dotx, then x evolution. You do need FSAL savings. */

/* This algorithm is more appropriate for heat current computation */
/* or total energy checksum when ddotx() of _start is called at k  */
/* = 0, if _stop was called at the last step, because exact p(nh), */
/* q(nh) would then be passed to ddotx(). Calvo93, Schlier00_6b,   */
/* Schlier00_8b, Schlier00_8c. */

/************************************************************/
/* The Development of Variable-Step Symplectic Integrators, */
/* With Application to the Two-Body Problem, M.P. Calvo,    */
/* J.M. Sanz-Serna, SIAM J. Sci. Comput. 14, 936-952 (1993) */
/* Numerical Hamiltonian Problems, J.M. Sanz-Serna,         */
/* M.P. Calvo, Chapman & Hall, London (1994).               */
/************************************************************/
/* evaluations per h-step:  4   */
/* global truncation error: h^4 */

/* First dotx, then x evolution. No FSAL savings yet. */
void symplectic_Calvo93_nofsal
(double h, int n, double *x, double *dotx, double *acc,
 Newtonian_ddotx ddotx);

/* FSAL sequence: _start, _fsal, _stop */
void symplectic_Calvo93_start
(double h, int n, double *x, double *dotx, double *acc,
 Newtonian_ddotx ddotx);
void symplectic_Calvo93_fsal
(double h, int n, double *x, double *dotx, double *acc,
 Newtonian_ddotx ddotx);
void symplectic_Calvo93_stop
(double h, int n, double *x, double *dotx, double *acc,
 Newtonian_ddotx ddotx);

/*******************************************************/
/* High-Order Symplectic Integration: An Assessment,   */
/* Ch. Schlier, A. Seiter, Comp. Phys. Comm. (2000)    */
/* phya8.physik.uni-freiburg.de/abt/papers/papers.html */
/*******************************************************/
/* evaluations per h-step:  8   */
/* global truncation error: h^6 */

/* First dotx, then x evolution. No FSAL savings yet. */
void symplectic_Schlier00_6b_nofsal
(double h, int n, double *x, double *dotx, double *acc,
 Newtonian_ddotx ddotx);

/* FSAL sequence: _start, _fsal, _stop */
void symplectic_Schlier00_6b_start
(double h, int n, double *x, double *dotx, double *acc,
 Newtonian_ddotx ddotx);
void symplectic_Schlier00_6b_fsal
(double h, int n, double *x, double *dotx, double *acc,
 Newtonian_ddotx ddotx);
void symplectic_Schlier00_6b_stop
(double h, int n, double *x, double *dotx, double *acc,
 Newtonian_ddotx ddotx);

/*******************************************************/
/* Ch. Schlier and A. Seiter, Comp. Phys. Comm. (2000) */
/*******************************************************/
/* evaluations per h-step:  17  */
/* global truncation error: h^8 */

/* First dotx, then x evolution. No FSAL savings yet.  */
void symplectic_Schlier00_8b_nofsal
(double h, int n, double *x, double *dotx, double *acc,
 Newtonian_ddotx ddotx);

/* FSAL sequence: _start, _fsal, _stop */
void symplectic_Schlier00_8b_start
(double h, int n, double *x, double *dotx, double *acc,
 Newtonian_ddotx ddotx);
void symplectic_Schlier00_8b_fsal
(double h, int n, double *x, double *dotx, double *acc,
 Newtonian_ddotx ddotx);
void symplectic_Schlier00_8b_stop
(double h, int n, double *x, double *dotx, double *acc,
 Newtonian_ddotx ddotx);

/*******************************************************/
/* Ch. Schlier and A. Seiter, Comp. Phys. Comm. (2000) */
/*******************************************************/
/* evaluations per h-step:  17  */
/* global truncation error: h^8 */

/* First dotx, then x evolution. No FSAL savings yet.  */
void symplectic_Schlier00_8c_nofsal
(double h, int n, double *x, double *dotx, double *acc,
 Newtonian_ddotx ddotx);

/* FSAL sequence: _start, _fsal, _stop */
void symplectic_Schlier00_8c_start
(double h, int n, double *x, double *dotx, double *acc,
 Newtonian_ddotx ddotx);
void symplectic_Schlier00_8c_fsal
(double h, int n, double *x, double *dotx, double *acc,
 Newtonian_ddotx ddotx);
void symplectic_Schlier00_8c_stop
(double h, int n, double *x, double *dotx, double *acc,
 Newtonian_ddotx ddotx);

/**********************************************************************/
/* Routers to various routines by K, the number of evaluations per h. */
/* To make fair comparison, one should use equal g for different K's. */
/* It gives "exact" x(wh) and dotx(wh), w=1..L, after each full step. */
/**********************************************************************/
void symplectic_nofsal ( int K, double g, int n, double *x, double *dotx,
                         double *acc, Newtonian_ddotx ddotx );

/**********************************************************************/
/* Routers to various routines by K, the number of evaluations per h. */
/* To make fair comparison, one should use equal g for different K's. */
/* To integrate t from 0 to Lh, one should call 1 x symplectic_start, */
/* (L-1) x symplectic_fsal, and 1 x symplectic_stop. One cannot have  */
/* "exact" x(wh) and dotx(wh) except when w=0,L, but capturing k=0    */
/* calls to ddotx(k,n,x,acc) at w=1..L-1 gives approximate answers.   */
/**********************************************************************/
void symplectic_start ( int K, double g, int n, double *x, double *dotx,
                        double *acc, Newtonian_ddotx ddotx );
void symplectic_fsal ( int K, double g, int n, double *x, double *dotx,
                       double *acc, Newtonian_ddotx ddotx );
void symplectic_stop ( int K, double g, int n, double *x, double *dotx,
                       double *acc, Newtonian_ddotx ddotx );

/*******************************************************/
/* Well known non-symplectic integrators & Benchmarks: */
/*******************************************************/

/************************************************************/
/* classic 4th-order Runge-Kutta method: Numerical Recipes  */
/* in C: The Art of Scientific Computing, William H. Press, */
/* Saul A. Teukolsky, William T. Vetterling, Brian P.       */
/* Flannery, Cambridge University Press, Cambridge (1992).  */
/* http://mathworld.wolfram.com/Runge-KuttaMethod.html      */
/************************************************************/
/* evaluations per h-step:  4   */
/* global truncation error: h^4 */

/* suited for heat current computation & total energy checksum at k=0 */

/* allocate 8*n internal workspace. No integration is performed yet. */
void rk4_prep ( double h, int n, double *x, double *dotx, double *acc,
                Newtonian_ddotx ddotx );
/* "acc" would not be used, so it can be passed as NULL. */
void rk4 (double h, int n, double *x, double *dotx, double *acc,
          Newtonian_ddotx ddotx);
/* free 8*n internal workspace */
void rk4_free ( double h, int n, double *x, double *dotx, double *acc,
                Newtonian_ddotx ddotx );

/**********************************************************/
/* Gear predictor-corrector algorithm: Numerical Initial  */
/* Value Problems in Ordinary Differential Equation,      */
/* C.W. Gear, Englewood Cliffs N.J., Prentice-Hall, 1971. */
/* itp.nat.uni-magdeburg.de/~schinner/dip/node22.html     */
/**********************************************************/
/* k-value: keep k n-arrays: x^0,x^1,..,x^{k-1}:          */
/* initialized by "exact" time derivatives.               */
/* Before corrector, x0 has local truncation error h^k;   */
/* after corrector, x0 has local truncation error h^(k+1) */
/* therefore the global truncation error of x0 is h^k.    */
/* The global truncation error of dotx is h^{k-1}, etc.   */
/**********************************************************/

#define GEAR_TEST_H  50

/* 4-value Gear predictor-corrector algorithm */
/* evaluations per h-step:  1   */
/* local  truncation error: h^5 */
/* global truncation error: h^4 */

/* Initialize 4-value Gear integrator and allocate 2*n  */
/* internal workspace. No integration is performed yet. */
void gear4_prep ( double h, int n, double *x, double *dotx, double *acc,
                  Newtonian_ddotx ddotx );
void gear4 ( double h, int n, double *x, double *dotx, double *acc,
             Newtonian_ddotx ddotx );
/* free 2*n internal workspace */
void gear4_free ( double h, int n, double *x, double *dotx, double *acc,
                  Newtonian_ddotx ddotx );

/******************************************************/
/* 5-value Gear predictor-corrector algorithm:        */
/* Computer Simulation of Liquids, M.P. Allen and     */
/* D.J. Tildesley, Clarendon Press, (Oxford 1987).    */
/* ftp://ftp.dl.ac.uk/ccp5/ALLEN_TILDESLEY/F.02       */
/* itp.nat.uni-magdeburg.de/~schinner/dip/node22.html */
/******************************************************/
/* evaluations per h-step:  1   */
/* local  truncation error: h^6 */
/* global truncation error: h^5 */

/* Initialize 5-value Gear integrator and allocate 3*n  */
/* internal workspace. No integration is performed yet. */
void gear5_prep ( double h, int n, double *x, double *dotx, double *acc,
                  Newtonian_ddotx ddotx );
void gear5 ( double h, int n, double *x, double *dotx, double *acc,
             Newtonian_ddotx ddotx );
/* free 3*n internal workspace */
void gear5_free ( double h, int n, double *x, double *dotx, double *acc,
                  Newtonian_ddotx ddotx );

/* 6-value Gear predictor-corrector algorithm */
/* evaluations per h-step:  1   */
/* local  truncation error: h^7 */
/* global truncation error: h^6 */

/* Initialize 6-value Gear integrator and allocate 4*n  */
/* internal workspace. No integration is performed yet. */
void gear6_prep ( double h, int n, double *x, double *dotx, double *acc,
                  Newtonian_ddotx ddotx );
void gear6 ( double h, int n, double *x, double *dotx, double *acc,
             Newtonian_ddotx ddotx );
/* free 4*n internal workspace */
void gear6_free ( double h, int n, double *x, double *dotx, double *acc,
                  Newtonian_ddotx ddotx );

/* 7-value Gear predictor-corrector algorithm */
/* evaluations per h-step:  1   */
/* local  truncation error: h^8 */
/* global truncation error: h^7 */

/* Initialize 7-value Gear integrator and allocate 5*n  */
/* internal workspace. No integration is performed yet. */
void gear7_prep ( double h, int n, double *x, double *dotx, double *acc,
                  Newtonian_ddotx ddotx );
void gear7 ( double h, int n, double *x, double *dotx, double *acc,
             Newtonian_ddotx ddotx );
/* free 5*n internal workspace */
void gear7_free ( double h, int n, double *x, double *dotx, double *acc,
                  Newtonian_ddotx ddotx );

/* 8-value Gear predictor-corrector algorithm */
/* evaluations per h-step:  1   */
/* local  truncation error: h^9 */
/* global truncation error: h^8 */

/* Initialize 8-value Gear integrator and allocate 6*n  */
/* internal workspace. No integration is performed yet. */
void gear8_prep ( double h, int n, double *x, double *dotx, double *acc,
                  Newtonian_ddotx ddotx );
void gear8 ( double h, int n, double *x, double *dotx, double *acc,
             Newtonian_ddotx ddotx );
/* free 6*n internal workspace */
void gear8_free ( double h, int n, double *x, double *dotx, double *acc,
                  Newtonian_ddotx ddotx );

/* symplectic algorithm 1 */
#define NEWTONIAN_RUTH83          0
#define NEWTONIAN_SCHLIER98_6A   (NEWTONIAN_RUTH83 + 1)
#define NEWTONIAN_TSITOURAS99    (NEWTONIAN_SCHLIER98_6A + 1)
#define NEWTONIAN_SYMPLECTIC_ALGORITHM_1_MAX  (NEWTONIAN_TSITOURAS99 + 1)
/* symplectic algorithm 2 */
#define NEWTONIAN_CALVO93        NEWTONIAN_SYMPLECTIC_ALGORITHM_1_MAX
#define NEWTONIAN_SCHLIER00_6B   (NEWTONIAN_CALVO93 + 1)
#define NEWTONIAN_SCHLIER00_8B   (NEWTONIAN_SCHLIER00_6B + 1)
#define NEWTONIAN_SCHLIER00_8C   (NEWTONIAN_SCHLIER00_8B + 1)
#define NEWTONIAN_SYMPLECTIC_ALGORITHM_2_MAX  (NEWTONIAN_SCHLIER00_8C + 1)
/* non-symplectic algorithms */
#define NEWTONIAN_RK4            NEWTONIAN_SYMPLECTIC_ALGORITHM_2_MAX
#define NEWTONIAN_GEAR4          (NEWTONIAN_RK4 + 1)
#define NEWTONIAN_GEAR5          (NEWTONIAN_GEAR4 + 1)
#define NEWTONIAN_GEAR6          (NEWTONIAN_GEAR5 + 1)
#define NEWTONIAN_GEAR7          (NEWTONIAN_GEAR6 + 1)
#define NEWTONIAN_GEAR8          (NEWTONIAN_GEAR7 + 1)
#define NEWTONIAN_MAX            (NEWTONIAN_GEAR8 + 1)

typedef void (*Integrator) ( double, int, double *, double *, double *,
                             Newtonian_ddotx );
typedef struct
{
    char *name;
    bool is_symplectic;
    int K;
    int order;
    Integrator a,b,c;
} Newtonian;

extern Newtonian newtonian [NEWTONIAN_MAX];

/***************************************************************/
/* prep  +  [ firststep, L-1 nextstep, halt ] repeat  +  free  */
/*            |                                                */
/* k=0 property calculation for algorithm 2 and non-symplectic */
/***************************************************************/

/* Allocate and initialize states if necessary, but do NOT integrate. */
void newtonian_integrator_prep
( int id, double g, int n, double *x, double *dotx,
  double *acc, Newtonian_ddotx ddotx );

/* Get the integrator to run its first full step of a session. */
void newtonian_integrator_firststep
( int id, double g, int n, double *x, double *dotx,
  double *acc, Newtonian_ddotx ddotx );

/* Run other full steps of a session. */
void newtonian_integrator_nextstep
( int id, double g, int n, double *x, double *dotx,
  double *acc, Newtonian_ddotx ddotx );

/* Halt the session and do necessary mop-ups. To */
/* start a new session, call _firststep again.   */
void newtonian_integrator_halt
( int id, double g, int n, double *x, double *dotx,
  double *acc, Newtonian_ddotx ddotx );

/* Free workspace if any. No more sessions. To restart, call _prep. */
void newtonian_integrator_free
( int id, double g, int n, double *x, double *dotx,
  double *acc, Newtonian_ddotx ddotx );

/** spline.c: **/

#define SPLINE_CUBIC_NATURAL   0
#define SPLINE_CUBIC_PERIODIC  1
#define SPLINE_AKIMA_NATURAL   2
#define SPLINE_AKIMA_PERIODIC  3

typedef struct
{
    gsl_spline *spline;
    gsl_interp_accel *acc;
    double xmin, xmax, ymax, ymin;
} Spline;

/* Allocate and initialize Spline structure based on */
/* lookup table x[0..N-1],y[0..N-1] and spline type. */
Spline *spline_initialize (int N, double *x, double *y, int spline_type);

/* Evaluate spline value. */
double spline_value (Spline *sp, double x);

/* Evaluate first-order derivative. */
double spline_deriv (Spline *sp, double x);

/* Evaluate second-order derivative. */
double spline_deriv2 (Spline *sp, double x);

/* Free all data structure. */
void spline_finalize (Spline *sp);

/** histogram.c: **/

typedef struct
{
    double xmin, xmax;   /* domain of interest: {xmin,xmax} */
    int bins;            /* # of collection bins in the domain of interest */
    double xbin;         /* width of one bin */
    int totalcount;      /* counts of total submission */
    double domaincount;  /* counts that fall into the domain of interest */
    double *bincount;    /* count in each bin */
    double *x_sample;    /* center x of each bin */
    double *density_profile;  /* density profile which integrates to 1 */
} Histogram;

/* Given finite xmin < xmax and bins >= 1, reallocate */
/* data structure in h and reset all counters.        */
void histogram_reinitialize
(double xmin, double xmax, int bins, Histogram *h);

/* Update histogram by data array x[0..n-1]; return domaincount */
double histogram_intercept (int n, double *x, Histogram *h);

/* Return the interception rate = domaincount / totalcount */
double histogram_interception_rate (Histogram *h);

/* Update the density profile; return the interception rate */
double histogram_update_density_profile (Histogram *h);

/* Save histogram in matlab script "fname" as  */
/* symbol "token" and notify I/O stream "info" */
double histogram_save_as_matlab
(Histogram *h, FILE *info, char *token, char *fname);
#define histogram_save_as_MATLAB(h,info,token) histogram_save_as_matlab\
  (h,info,token,str2(token,"_h.m"))

/* Clear all counters as if it is just the beginning */
void histogram_reset_all_counters (Histogram *h);

/* Free the histogram data structure and reset all counters */
void histogram_free (Histogram *h);

#endif  /* _Scalar_h */


/* sys/ldfrexp.c
 *
 * Copyright (C) 2002, Gert Van den Eynde
 *
 * 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>

double
gsl_ldexp (const double x, const int e)
{
  double p2 = pow (2.0, (double)e);
  return x * p2;
}

double
gsl_frexp (const double x, int *e)
{
  if (x == 0.0)
    {
      *e = 0;
      return 0.0;
    }
  else
    {
      double ex = ceil (log (fabs (x)) / M_LN2);
      int ei = (int) ex;
      double f = gsl_ldexp (x, -ei);

      while (fabs (f) >= 1.0)
        {
          ei++;
          f /= 2.0;
        }

      while (fabs (f) < 0.5)
        {
          ei--;
          f *= 2.0;
        }

      *e = ei;
      return f;
    }
}


#include <stdio.h>
#include <math.h>
#include <gsl/gsl_integration.h>

#include "timer.h"

void integral_recur (int nmin, int nmax, double vals[]);
void integral_gen (int nmin, int nmax, double vals[]);
double ff (double x, void *params);
int adjust_rep_count (int count, double time, double tmin, double tmax);

double ff (double x, void *params)
{
    double n = *(double *) params;
    double f = exp (-x) * pow (x, n);

    return f;
}

void integral_recur (int nmin, int nmax, double vals[])
{
    int i;

    vals[nmax] = 0.;
    for (i = nmax - 1; i >= nmin; i--)
    {
        vals[i] = vals[i + 1] / (i + 1) + 1. / ((i + 1) * M_E);
    }
}

void integral_gen (int nmin, int nmax, double vals[])
{
    int i;
    double result, error;
    double a = 0., b = 1.;
    double abserr = 1.e-9, relerr = 1.e-9;
    double n;
    size_t np = 1000;
    gsl_integration_workspace *w = gsl_integration_workspace_alloc (np);

    gsl_function F;

    F.function = &ff;

    for (i = nmax; i >= nmin; i--)
    {
        n = (double) i;
        F.params = &n;

        gsl_integration_qag (&F, a, b, abserr, relerr, np, GSL_INTEG_GAUSS15,
            w, &result, &error);

        vals[i] = result;
    }

    gsl_integration_workspace_free (w);

}

#define N 100

int main (void)
{
    int i;
    double integral1[N + 1], integral2[N + 1];
    int nmax = N;
    int nmin = 10;

    integral_recur (nmin, nmax, integral1);
    integral_gen (nmin, nmax, integral2);

    for (i = nmin; i <= nmax; i++)
    {
        printf ("%5d    % 14.6f   % 14.6f   %g\n", i, integral1[i],
            integral2[i], fabs (integral1[i] - integral2[i]));
    }

    double time, time1, time2, tmin = 1., tmax = 2.;
    int count = 1000;

    do
    {

        timer_start ();
        for (i = 0; i < count; i++)
        {
            integral_recur (nmin, nmax, integral1);
        }
        time = timer_stop ();

        time1 = time / count;
        printf ("Recur: %10.2f usec %10.6f sec %10d\n", time1 * 1.e6, time,
            count);
        /*
         * adjust count such that cpu time is between
         * tmin and tmax
         */
        count = adjust_rep_count (count, time, tmin, tmax);
    }
    while ((time > tmax) || (time < tmin));

    count = 1000;

    do
    {

        timer_start ();
        for (i = 0; i < count; i++)
        {
            integral_gen (nmin, nmax, integral2);
        }
        time = timer_stop ();

        time2 = time / count;
        printf ("Integ: %10.2f usec %10.6f sec %10d\n", time1 * 1.e6, time,
            count);
        /*
         * adjust count such that cpu time is between
         * tmin and tmax
         */
        count = adjust_rep_count (count, time, tmin, tmax);
    }
    while ((time > tmax) || (time < tmin));

    printf ("Speedup: %.2f\n", time2 / time1);

    return 0;
}


#include <stdio.h>
#include <gsl/gsl_math.h>

#include <gsl/gsl_monte.h>		//Relevant GSL functions for VEGAS numerical integration
#include <gsl/gsl_monte_vegas.h>

#include "timer.c"			//Timing Functions
#include "plotfun.h"			//Automatic Plotting Function

void timer_start (void);
double timer_stop (void);

void pfun(double x[], double y[], double u[], double v[], int points);

extern double g (double *t, size_t dim, void *params);
struct my_params {double r;};

double f (double x1, double x2, double y1, double y2, double z1, double z2, double r);

double dipole_approx (double r);

int main (void)
{
	int np = 20;
	double distance[20];
	double vegas_energy[20];
	double res, err;
        double error1[20];
	double error2[20];

	size_t dim = 6;
	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;

	double dd = (4.-1.001)/np;

	timer_start();

	for(int q = 0; q < np; q++)
	{
		distance[q] = 1.001 + q*dd;
	}

	//VEGAS Integration

	for(int j = 0; j < np; j++)
	{
		struct my_params params = {distance[j]};
		gsl_monte_function G = { &g, dim , &params};

		gsl_monte_vegas_state *sv = gsl_monte_vegas_alloc (dim);

		gsl_monte_vegas_init (sv);

		gsl_monte_vegas_integrate (&G, xl, xu, dim, calls / 10, r, sv, &res, &err);

		do
		{
			gsl_monte_vegas_integrate (&G, xl, xu, dim, calls, r, sv, &res, &err);
			fflush (stdout);
		}
		while (fabs (gsl_monte_vegas_chisq (sv) - 1.0) > 0.2);
		vegas_energy[j] = fabs(res);
		error1[j] = fabs(err);

		gsl_monte_vegas_free (sv);
	}

	double t1 = timer_stop();

	gsl_rng_free (r);

	int iterations = 1000000;
	int tot = 20;
	double x1, x2, y1, y2, z1, z2;
	double handmade_energy[20];

	gsl_rng *zed = gsl_rng_alloc (gsl_rng_taus2);

	gsl_rng_set (zed, seed);

	timer_start();

	//Handmade Monte Carlo Integrator

	for(int j = 0; j < 20.; j++)
	{
	    double d = 1.001 + j * dd;
	    double ival = 0;
	    double i2val = 0;
	    for(int z = 0; z < 16; z++)
	    {
	      double value = 0;
       		for (int q = 0; q < iterations; q++)
        	{
            		x1 = gsl_rng_uniform(zed);
            		x2 = gsl_rng_uniform(zed);
            		y1 = gsl_rng_uniform(zed);
            		y2 = gsl_rng_uniform(zed);
            		z1 = gsl_rng_uniform(zed);
            		z2 = gsl_rng_uniform(zed);
            		value += f(x1, x2, y1, y2, z1, z2, d);
       		}
		ival += value;
		i2val += value*value;
	    }

	    double result = ival/iterations/16;
	    double result2 = i2val/iterations/iterations/16;

	    error2[j] = sqrt(fabs((result*result)-result2));

	    handmade_energy[j] = fabs(result);
	}

	double t2 = timer_stop();

	//Dipole Approximation

	double dipole_energy[20];
	for(int u = 0; u < tot; u++)
	{
		dipole_energy[u] = dipole_approx(distance[u]);
	}

	printf("Distance   VEGAS      Error      Handmade   Error      Dipole\n");

	for(int w = 0; w < tot; w++)
	{
	  printf("%.6f   %.6f   %.6f   %.6f   %.6f   %.6f\n", distance[w], vegas_energy[w], error1[w], handmade_energy[w], error2[w], dipole_energy[w]);
	}

	printf("Time for VEGAS:  %.6f\nTime for HANDMADE:  %.6f\n", t1, t2);

	//Plots the 3 methods vs. distance automatically (function in plotfun.h)

	pfun(distance, vegas_energy, handmade_energy, dipole_energy, 20);

	return 0;
}

double g (double *t, size_t dim, void *params)
{
    	double dist2, delta;
    	double rho1, rho2;
    	int sdim = ((int) dim)/2;
    	double r = *((double *) params);

    	dist2 = 0.;
    	for (int i = 0; i < sdim; i++)
    	{
        	delta = t[i] - t[i + sdim];
        	if (i == 0)
        	{
           		delta += r;
        	}
        	dist2 += delta*delta;
    	}

    	double norm = 512./(9.*(M_PI - 2.));
    	rho1 = norm * atan(2*(t[0]-.5))*pow(sin(M_PI*t[1]),4.)*pow(sin(M_PI*t[2]),4.);
    	rho2 = norm * atan(2*(t[3]-.5))*pow(sin(M_PI*t[4]),4.)*pow(sin(M_PI*t[5]),4.);

    	return rho1*rho2/sqrt(dist2);
}

double f (double x1, double x2, double y1, double y2, double z1, double z2, double r)
{
	double dist2;
    	double rho1, rho2;

    	dist2 = (x1 - x2 + r)*(x1 - x2 + r) + (y1 - y2)*(y1 - y2) + (z1 - z2)*(z1 - z2);

    	double norm = 512./(9.*(M_PI - 2.));
    	rho1 = norm * atan(2*(x1-.5))*pow(sin(M_PI*y1),4.)*pow(sin(M_PI*z1),4.);
    	rho2 = norm * atan(2*(x2-.5))*pow(sin(M_PI*y2),4.)*pow(sin(M_PI*z2),4.);

    	return rho1*rho2/sqrt(dist2);
}

double dipole_approx (double r)
{
	return 2/(r*r*r);
}


#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include "compearth.h"
#ifdef COMPEARTH_USE_MKL
#ifdef __clang__
#pragma clang diagnostic push
#pragma clang diagnostic ignored "-Wreserved-id-macro"
#pragma clang diagnostic ignored "-Wstrict-prototypes"
#endif
#include <mkl_cblas.h>
#ifdef __clang__
#pragma clang diagnostic pop
#endif
#else
#include <cblas.h>
#endif

/*!
 * @brief Computes the angle between moment tensors.  This is from
 *        Equation 15 of Tape and Tape 2016 - A confidence parameter for
 *        seismic moment tensors
 *
 * @param[in] n       Number of moment tensors.
 * @param[in] M1in    First moment tensor packed {m11, m22, m33, m12, m13, m23}.
 *                    This is an array of dimension [6 x n] with leading
 *                    dimension 6.
 * @param[in] M2in    Second moment tensor packed {m11, m22, m33, m12, m13, m23}.
 *                    This is an array of dimension [6 x n] with leading
 *                    dimension 6.
 *
 * @param[out] theta  Angle between moment tensors M1 and M2 in radians.
 *                    This is an array of dimension [n].
 *
 * @result 0 indicates success.
 *
 * @author Ben Baker
 *
 * @copyright MIT
 *
 */
int compearth_angleMT(const int n,
                      const double *__restrict__ M1in,
                      const double *__restrict__ M2in,
                      double *__restrict__ theta)
{
    double M1[9*CE_CHUNKSIZE] __attribute__((aligned(64)));
    double M2[9*CE_CHUNKSIZE] __attribute__((aligned(64)));
    double M1_mag[CE_CHUNKSIZE] __attribute__((aligned(64)));
    double M2_mag[CE_CHUNKSIZE] __attribute__((aligned(64)));
    double xden[CE_CHUNKSIZE] __attribute__((aligned(64)));
    double arg[CE_CHUNKSIZE] __attribute__((aligned(64)));
    double xnum[CE_CHUNKSIZE] __attribute__((aligned(64)));
    int i, ierr, imt, nmtLoc;
    ierr = 0;
    for (imt=0; imt<n; imt=imt+CE_CHUNKSIZE)
    {
        nmtLoc = MIN(CE_CHUNKSIZE, n - imt);
        // Convert to 3x3 matrices
        compearth_Mvec2Mmat(nmtLoc, &M1in[6*imt], 1, M1);
        compearth_Mvec2Mmat(nmtLoc, &M2in[6*imt], 1, M2);
        // Compute norms
        ierr = compearth_normMat(nmtLoc, M1, CE_TWO_NORM, 2.0, M1_mag);
        ierr = compearth_normMat(nmtLoc, M2, CE_TWO_NORM, 2.0, M2_mag);
        // Compute the denomimators
        for (i=0; i<nmtLoc; i++)
        {
            xden[i] = M1_mag[i]*M2_mag[i];
        }
        // Compute the numerators
        for (i=0; i<nmtLoc; i++)
        {
            xnum[i] = cblas_ddot(9, &M1[9*i], 1, &M2[9*i], 1);
        }
        // Compute argument and do all checks
        for (i=0; i<nmtLoc; i++)
        {
            // Can't divide by zero - force this to work b/c M1 or M2 is
            // equivalently 0.
            if (xden[i] == 0.0)
            {
                xnum[i] = 0.0;
                xden[i] = 1.0;
                fprintf(stderr, "%s: Denominator is 0\n", __func__);
            }
            arg[i] = xnum[i]/xden[i];
            // Correct for numerical errors
            if (arg[i] <-1.0)
            {
                fprintf(stdout, "%s: Warning arg is %f setting to -1\n",
                         __func__, arg[i]);
                arg[i] =-1.0;
            }
            if (arg[i] > 1.0)
            {
                fprintf(stdout, "%s: Warning arg is %f setting to +1\n",
                        __func__, arg[i]);
                arg[i] = 1.0;
            }
        }
        // Finally compute the angle
        for (i=0; i<nmtLoc; i++)
        {
            theta[imt+i] = acos(arg[i]);
        }
    }
    return ierr;
}


/* Original simple matrix class taken from http://www.algarcia.org/nummeth/Cpp/Matrix.h */

#ifndef MATRIX_H
#define MATRIX_H

#include <assert.h>  // Defines the assert function.
//#define assert(x) {} //to avoid bound checking
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_blas.h>
#include <gsl/gsl_linalg.h>
#include <gsl/gsl_errno.h>

#include <string.h>
#include <stdio.h>

#define BUFF_SIZE 4096

class Matrix {

public:

// Default Constructor. Creates a 1 by 1 matrix; sets value to zero.
Matrix () {
  ma = gsl_matrix_alloc( 1, 1);// Allocate memory
  ve.owner = 0;
  ve.block = ma->block;
  set(0.0);                // Set value of data_[0] to 0.0

  header = NULL;
}

// Regular Constructor. Creates an nR by nC matrix; sets values to zero.
// If number of columns is not specified, it is set to 1.
Matrix(int nR, int nC = 1, char *head=NULL) {
  assert(nR > 0 && nC > 0);    // Check that nC and nR both > 0.
  ma = gsl_matrix_alloc( nR, nC);// Allocate memory
  ve.owner = 0;
  ve.block = ma->block;
  set(0.0);                    // Set values of data_[] to 0.0

  if (head != NULL)
	header = strdup(head);
  else
	header = NULL;
}

//copy constructor
Matrix(Matrix &mat)  {
printf("Matrix::Matrix 2 ...\n");
  ma = gsl_matrix_alloc( mat.nRow(), mat.nCol());// Allocate memory
  ve.owner = 0;
  ve.block = ma->block;
  copy(mat);

  if (mat.Header() != NULL)
	header = strdup(mat.Header());
  else
	header = NULL;

}

//Identity (preferably square) matrix
void Iden() {
  //assert(nRow() == nCol());    // Check that square matrix.
  set(0.0);                    // Set values of data_[] to 0.0
  for (int i=0; i<nRow(); i++)
	ma->data[ (ma->tda)*i + i] = 1.0;
}

// Destructor. Called when a Matrix object goes out of scope or deleted.
~Matrix() {
	//printf("Matrix::~Matrix\n");
	if (ma != NULL)
		  gsl_matrix_free(ma);   // Release allocated memory
	if (header != NULL) {
		free(header);
	}
}

// Assignment operator function.
// Overloads the equal sign operator to work with
// Matrix objects.
Matrix& operator=(const Matrix& mat) {
  if( this == &mat ) return *this;  // If two sides equal, do nothing.
  this->copy(mat);                  // Copy right hand side to l.h.s.
  return *this;
}

// += operator function.
// Overloads the += sign operator to work with
// Matrix objects.
Matrix& operator+=(const Matrix& mat) {
  gsl_matrix_add( this->ma, mat.ma);
  return *this;
}

// -= operator function.
// Overloads the -= sign operator to work with
// Matrix objects.
Matrix& operator-=(const Matrix& mat) {
  gsl_matrix_sub( this->ma, mat.ma);
  return *this;
}

// *= operator function.
// Overloads the *= sign operator to work with
// Matrix objects.
Matrix& operator*=(const double a) {
  gsl_matrix_scale( this->ma, a);
  return *this;
}

// Set function. Sets all elements of a matrix to a given value.
void set(double value) {
   gsl_matrix_set_all( ma, value);
}

/*// Set function. Sets all elements of a matrix to a given value.
void eval(double value, double (*fct)(double x)) {
   to be done
}*/

//info
// Simple "get" functions. Return number of rows or columns.
int nRow() const { return ma->size1; }
int nCol() const { return ma->size2; }

//min and max
double Max() { gsl_matrix_max(ma); }
double Min() { gsl_matrix_min(ma); }

// Parenthesis operator function.
// Allows access to values of Matrix via (i,j) pair.
// Example: a(1,1) = 2*b(2,3);
// If column is unspecified, take as 1.
double& operator() (int i, int j = 0) {
  assert(i >= 0 && i < ma->size1);          // Bounds checking for rows
  assert(j >= 0 && j < ma->size2);          // Bounds checking for columns
  return ma->data[ (ma->tda)*i + j];  // Access appropriate value
}

// Parenthesis operator function (const version).
const double& operator() (int i, int j = 0) const{
  assert(i >= 0 && i < ma->size1);          // Bounds checking for rows
  assert(j >= 0 && j < ma->size2);          // Bounds checking for columns
  return ma->data[(ma->tda)*i + j];  // Access appropriate value
}

// Allows access to values of Matrix via ele(i,j) pair.
// If column is unspecified, take as 1.
double ele(int i, int j = 0) {
  assert(i >= 0 && i < ma->size1);          // Bounds checking for rows
  assert(j >= 0 && j < ma->size2);          // Bounds checking for columns
  return ma->data[ (ma->tda)*i + j];  // Access appropriate value
}

//i/o
//Print function
void print( FILE *F, char *name=NULL, int fw=11, int pres=4, char *sep=" ", int rownums=0, int colnums=0)
{
	if (name == NULL)
		if (header == NULL)
			fprintf( F, "\n");
		else
			fprintf( F, "%s\n", header);
	else
		fprintf( F, "%s", name);
	for (int i=0; i<ma->size1; i++)
	{
		if ((i == 0) && (colnums)) {
			fprintf( F, "%*s%s", fw, "", sep);
			for (int j=0; j<ma->size2; j++)
				fprintf( F, "%*d%s", fw, j, sep);
			fprintf(F, "\n");
		}
		for (int j=0; j<ma->size2; j++) {
			if ((j == 0) && (rownums))
				fprintf( F, "%3d%s", i, sep);
			fprintf( F, "%*.*g%s", fw, pres, ele(i,j), sep);
		}
		fprintf( F, "\n");
	}
}
void print(char *name=NULL) { print( stdout, name, 11, 4, " ", 0, 0); }
void printnums(char *name=NULL) { print( stdout, name, 11, 4, " ", 1, 1); }

void fileprint(char *fnam) {
	FILE *F;

	if ((F = fopen( fnam, "w+")) == NULL)
	{
		printf( "Could not open file %s for writing\n", fnam);

		assert(F == NULL);
	}
	else
	{
		print( F, NULL, 11, 4, " ");

		fclose(F);
	}
}

void printrow(int i) {
	assert(i < nRow());

	for (int j=0; j<ma->size2; j++) {
		printf( "%*.*g%s", 11, 4, ele(i,j), " ");
	}
	printf( "\n");
}

int filescan(char *fnam, int file_header=0) {
	FILE *F;

	if ((F = fopen( fnam, "r")) == NULL)
	{
		printf( "File %s not found\n", fnam);

		return 0;
	}
	else
	{
		if (file_header == 1) {
			header = (char *) malloc((size_t) BUFF_SIZE);

			header = fgets( header, (size_t) BUFF_SIZE, F);
			header[strlen(header)-1] = '\0'; //remove the \n
		}

		gsl_matrix_fscanf( F, ma);

		fclose(F);
		return 1;
	}
}

/*********************** Views *********************/
//Get the gsl matrix
gsl_matrix *Ma() { return ma; }

//Column gsl Vector
gsl_vector *AsColVec(int Col)   {
	assert(Col >= 0 && Col < ma->size2);          // Bounds checking for columns
	ve.size = ma->size1;
	ve.stride = ma->tda;
	ve.data = ma->data + Col;

	return &ve;
}
//First column is the defalut
gsl_vector *Ve()   {
	ve.size = ma->size1;
	ve.stride = ma->tda;
	ve.data = ma->data;

	return &ve;
}

//Row Vector
gsl_vector *AsRowVec(int Row, int ChopOff=0)   {
	assert(Row >= 0 && Row < ma->size1);          // Bounds checking for rows
	ve.size = ma->size2-ChopOff;
	ve.stride = 1;
	ve.data = ma->data + (ma->tda)*Row;

	return &ve;
}

// Copy function.
// Copies values from one Matrix object to another.
void Copy(const Matrix *mat) {

	assert((nRow() == mat->nRow()) && (nCol() == mat->nCol()));
    gsl_matrix_memcpy( ma, mat->ma);
}

// Copy function.
// Copies values from one Matrix object to another.
void copy(const Matrix& mat) {
    gsl_matrix_memcpy( ma, mat.ma);
}

const char *Header() { return header; }

//*********************************************************************
protected:

// Matrix data.
gsl_matrix *ma;
gsl_vector ve;

char *header;

}; // Class Matrix

class SubMatrix : public Matrix {

private:
	gsl_matrix_view view;
	Matrix *Parent;

public:
	SubMatrix(Matrix &mat, size_t k1, size_t k2, size_t n1, size_t n2) {
		view = gsl_matrix_submatrix ( mat.Ma(), k1, k2, n1, n2);
		ma = &view.matrix;
		Parent = &mat;
		if (mat.Header() != NULL)
			header = strdup(mat.Header());
		else
			header = NULL;
	}

	SubMatrix( Matrix& mat, size_t n1, size_t n2) {
		view = gsl_matrix_submatrix ( mat.Ma(), (size_t) 0, (size_t) 0, n1, n2);
		ma = &view.matrix;
		Parent = &mat;
		if (mat.Header() != NULL)
			header = strdup(mat.Header());
		else
			header = NULL;
	}

	SubMatrix() {
	//delay the opening of this submatrix
		ma = NULL;
		Parent = NULL;
		header = NULL;
	}

	~SubMatrix() {
		ma = NULL; //we avoid the base class call to free with this
		if (header != NULL) {
			free(header);
			header=NULL;
		}

	}

	void Set(Matrix *mat, size_t k1, size_t k2, size_t n1, size_t n2) {
		view = gsl_matrix_submatrix ( mat->Ma(), k1, k2, n1, n2);
		ma = &view.matrix;
		Parent = mat;
		if (mat->Header() == NULL)
			header = NULL;
		else
			header = strdup(mat->Header());
	}

	const char *SetHeader(char *head) {
		if (header != NULL)
			free(header);
		header == NULL;
		if (head != NULL)
			header = strdup(head);
		return header;
	}

// Assignment operator function.
// Overloads the equal sign operator to work with
// Matrix objects.
SubMatrix& operator=(const SubMatrix& mat) {
  if( this == &mat ) return *this;  // If two sides equal, do nothing.
  this->copy(mat);                  // Copy right hand side to l.h.s.
  return *this;
}

// += operator function.
// Overloads the += sign operator to work with
// Matrix objects.
SubMatrix& operator+=(const SubMatrix& mat) {
  gsl_matrix_add( this->ma, mat.ma);
  return *this;
}

// -= operator function.
// Overloads the -= sign operator to work with
// Matrix objects.
SubMatrix& operator-=(const SubMatrix& mat) {
  gsl_matrix_sub( this->ma, mat.ma);
  return *this;
}

// *= operator function.
// Overloads the *= sign operator to work with
// Matrix objects.
SubMatrix& operator*=(const double a) {
  gsl_matrix_scale( this->ma, a);
  return *this;
}

	void Set( Matrix *mat, size_t n1, size_t n2) {
		view = gsl_matrix_submatrix ( mat->Ma(), (size_t) 0, (size_t) 0, n1, n2);
		ma = &view.matrix;
		Parent = mat;
	}

	void ReSize(size_t k1, size_t k2, size_t n1, size_t n2) {
		view = gsl_matrix_submatrix( Parent->Ma(), k1, k2, n1, n2);
		ma = &view.matrix;
	}

	void ReSize(size_t n1, size_t n2) {
		view = gsl_matrix_submatrix ( Parent->Ma(), (size_t) 0, (size_t) 0, n1, n2);
		ma = &view.matrix;
	}

};

/*Auxiliary functions*/
//C = A^trA B^trB
int MatMul(Matrix &C, int trA, Matrix &A, int trB, Matrix &B);
int MatMul(Matrix &C, Matrix &A, Matrix &B);
double CuadForm(Matrix &A, Matrix &b);
int MatMulSym(Matrix &C, Matrix &A, Matrix &B);
//inverse of real (symetric) positive defined matrix
//as a by product we may obtain the square root of the determinat of A
int InvRPD(Matrix &R, Matrix &A, double *LogDetSqrt=NULL, Matrix *ExternChol=NULL);
//I have seen problems with this when dest and src are rows or cls of the same matrix
int VecCopy(gsl_vector * dest, const gsl_vector * src);

#endif


#ifndef __GSLEXTRA_H__
#define __GSLEXTRA_H__

#include <iostream>
#include <math.h>
#include <stdio.h>
#include <string.h>
#include <gsl/gsl_sf.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_linalg.h>
#include <gsl/gsl_permutation.h>
#include <gsl/gsl_complex.h>
#include <gsl/gsl_complex_math.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_eigen.h>
#include <gsl/gsl_poly.h>
#include <gsl/gsl_integration.h>
#include <gsl/gsl_sort.h>
#include <gsl/gsl_sort_vector.h>

#endif

void gsl_vector_complex_convert(gsl_vector * source, gsl_vector_complex * target, int length);
void gsl_matrix_complex_convert(gsl_matrix * source, gsl_matrix_complex * target, int rows, int columns);
void gsl_vector_complex_extract(gsl_vector_complex * source, gsl_vector * real, gsl_vector * imag, int length);
void gsl_matrix_complex_extract(gsl_vector_complex * source, gsl_matrix * real,gsl_matrix * imag, int rows, int columns);
void gsl_vector_complex_combine(gsl_vector * real, gsl_vector * imag, gsl_vector_complex * target);
void gsl_matrix_complex_combine(gsl_matrix * real,gsl_matrix * imag, gsl_matrix_complex * target);
void gsl_matrix_diag(gsl_matrix * target, gsl_vector * diag, int length);
void gsl_matrix_complex_diag(gsl_matrix_complex * target, gsl_vector_complex * diag, int length);
void gsl_matrix_mul(gsl_matrix * A, gsl_matrix *B, gsl_matrix * Result,int Acolumn,int Arow,int Bcolumn);
void gsl_matrix_complex_mul(gsl_matrix_complex * A, gsl_matrix_complex *B, gsl_matrix_complex * Result,int Acolumn,int Arow,int Bcolumn);
double gsl_vector_inner_product(gsl_vector * A, gsl_vector * B,int length);
gsl_complex gsl_vector_complex_product(gsl_vector_complex * A, gsl_vector_complex * B, int length);
gsl_complex gsl_vector_complex_inner_product(gsl_vector_complex * A, gsl_vector_complex * B, int length);
void gsl_vector_transform(gsl_vector * vec,gsl_matrix * trf,int length);
void gsl_vector_complex_transform(gsl_vector_complex * vec, gsl_matrix_complex * trf,int length);
void gsl_matrix_unitmatrix(gsl_matrix * m,int length);
void gsl_matrix_complex_unitmatrix(gsl_matrix_complex * m,int length);
void gsl_vector_complex_conjugate(gsl_vector_complex * v, int length);
void gsl_matrix_complex_conjugate(gsl_matrix_complex * m, int rows, int columns);


#include <math.h>
#include <lapacke.h>
#include <complex.h>

//#include "WignerD_fftw.h"

#include <stdio.h>

#define max(a,b) \
   ({ __typeof__ (a) _a = (a); \
       __typeof__ (b) _b = (b); \
     _a > _b ? _a : _b; })

#define min(x,y) (((x) < (y)) ? (x) : (y))

#define MAXFILENAME 100

lapack_complex_double *Iy_Matrix(lapack_int Ndim)
{
double J = (Ndim-1)/2.;
lapack_complex_double *AB = calloc(Ndim*2,sizeof(lapack_complex_double));

lapack_complex_double zero = lapack_make_complex_double(0.0,0.0);
lapack_complex_double myimag = lapack_make_complex_double(0.0,1.0);
//prepare the upper triangle of Iy
//the array is computed in FORTRAN style (transposed)
   double m;
   for (int i=0; i<Ndim; i++){
     m = i-J;
     AB[2*i] =  sqrt((J+m)*(J-m+1.)) / 2.*(-myimag);
	 AB[2*i+1] =  zero;
	 //printf("Hal %f \n" , cimag(AB[i]));
    }

  return AB;
}

lapack_complex_double *Iy_Eigsystem_Lapacke(lapack_int Ndim)
{

char JOBZ, UPLO;
   lapack_int KD, LDAB, LDZ, INFO;

   JOBZ='V'; //= 'V':  Compute eigenvalues and eigenvectors.
   UPLO='U'; // = 'U':  Upper triangle of A is stored;
   KD=1;  //number of superdiagonals
   LDAB=KD+1;  //The leading dimension of the array AB = 2
   LDZ=max(1,Ndim); //The leading dimension of the array eigenvectors

   //int rworksize=max(1,3*Ndim-2);

   //Initialize the array that holds the eigenvalues
    double *Eigenvalue;
	lapack_complex_double *Eigenvec, *WORK; //AB is transposed because of FORTRAN array struct.

	Eigenvec = calloc(Ndim*Ndim,sizeof(lapack_complex_double));
	WORK = calloc(Ndim,sizeof(lapack_complex_double));
	Eigenvalue = calloc(Ndim,sizeof(double));

    lapack_complex_double *AB = Iy_Matrix(Ndim);  //Create the upper triangle matrix

    INFO = LAPACKE_zhbev(LAPACK_COL_MAJOR, JOBZ, UPLO, Ndim,
                          KD, AB,
                          LDAB, Eigenvalue, Eigenvec,
                          LDZ );

	free(AB);
	free(Eigenvalue);
	free(WORK);
	return Eigenvec;

}

void PrecalculateEigenvec(int Ndim)
{
    lapack_complex_double *Eigenvec = Iy_Eigsystem_Lapacke(Ndim);

	char filename[MAXFILENAME+1];

	snprintf(filename, MAXFILENAME, "../../Calculated/Eigenvectors/EigenvectorsD%d.dat", Ndim);

	FILE* file = fopen(filename, "wb");

	if (file == NULL){
		printf("CANNOT OPEN FILE FOR WRITING: %s\n",filename);
		abort();
	}
	//else printf("WRITING TO FILE: %s\n",filename);

    const int size = sizeof(lapack_complex_double);
	const int fftdim = 2*(Ndim-1)+1;

    for (int m=0; m<Ndim; m++){
	for (int mu=0; mu<Ndim; mu++){
        if (fwrite(&Eigenvec[m + Ndim*mu], 1, size, file) != size){
			printf("ERROR WHILE WRITING TO FILE: %s\n",filename);
			abort();
		}
	}}
	free(Eigenvec);
	fclose(file);
}

int main(){
    int MAXDIM = 120;

	for (int Ndim=2; Ndim<=MAXDIM; Ndim++){
		PrecalculateEigenvec(Ndim);
		printf("Eigenvectors calculated for dimension %d\n", Ndim);
	}
	return 0;
}


/* randist/lognormal.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 lognormal distribution has the form

   p(x) dx = 1/(x * sqrt(2 pi sigma^2)) exp(-(ln(x) - zeta)^2/2 sigma^2) dx

   for x > 0. Lognormal random numbers are the exponentials of
   gaussian random numbers */

double
gsl_ran_lognormal (const gsl_rng * r, const double zeta, const double sigma)
{
  double u, v, r2, normal, z;

  do
    {
      /* choose x,y in uniform square (-1,-1) to (+1,+1) */

      u = -1 + 2 * gsl_rng_uniform (r);
      v = -1 + 2 * gsl_rng_uniform (r);

      /* see if it is in the unit circle */
      r2 = u * u + v * v;
    }
  while (r2 > 1.0 || r2 == 0);

  normal = u * sqrt (-2.0 * log (r2) / r2);

  z =  exp (sigma * normal + zeta);

  return z;
}

double
gsl_ran_lognormal_pdf (const double x, const double zeta, const double sigma)
{
  if (x <= 0)
    {
      return 0 ;
    }
  else
    {
      double u = (log (x) - zeta)/sigma;
      double p = 1 / (x * fabs(sigma) * sqrt (2 * M_PI)) * exp (-(u * u) /2);
      return p;
    }
}


#pragma once

#include <iostream>
#include <map>
#include <memory>
#include <string>
#include <vector>

#include <gsl/gsl_complex.h>
#include <gsl/gsl_math.h>

#include "../Scanner/scanner.h"
#include "../Utils/Types.h"

class Expression;

typedef std::shared_ptr<Expression> expression;
typedef std::map<std::string, expression> Variables;

extern const Variables emptyVars;

typedef expression(*TransformerFunction)(expression);

class Expression: public std::enable_shared_from_this<Expression> {

    public:
        const Scanner::Type kind;

        Expression(Scanner::Type kind);
        virtual ~Expression();

        virtual expression simplify();
        virtual expression derivative(const std::string& var);
        virtual expression integrate(const std::string& var);

        virtual bool isComplex() const = 0;
        virtual bool isEvaluable(const Variables& vars = emptyVars) const = 0;
        virtual bool isNumber() const { return false; }

        virtual expression eval(const Variables& vars = emptyVars) = 0;
        virtual double value(const Variables& vars = emptyVars) const = 0;
        virtual gsl_complex complex(const Variables& vars = emptyVars) const;

        virtual bool equals(expression, double precision=1e-15) const = 0;

        std::vector<double> array();
        virtual expression at(const int index);
        virtual double get(const int index);
        virtual size_t shape(const int axis) const;
        virtual size_t size() const;

        virtual expression call(expression e);
        inline expression operator()(expression e){ return call(e); }

        virtual expression apply(TransformerFunction f);
        inline expression operator()(TransformerFunction f){ return apply(f); }

        inline bool is(Scanner::Type kind) const { return this->kind == kind; }
        virtual std::string repr() const;
        virtual int id() const;

        expression copy();

        virtual std::ostream& print(std::ostream&, const bool pretty=false) const = 0;
        virtual std::ostream& postfix(std::ostream&) const = 0;

    private:
        struct gsl_expression_struct {
            Expression* e;
            const std::string var;
            Variables vars;

            gsl_expression_struct(Expression*, const std::string var = "x");
        };
        static double gsl_expression_function(double x, void* p);
        std::unique_ptr<gsl_expression_struct> gsl_params;

    public:
        virtual gsl_function function(const std::string& var = "x");

    private:
        struct ExpressionIterator {
            expression e;
            size_t index;

            ExpressionIterator(expression e, size_t index);

            expression operator*();

            bool operator==(const ExpressionIterator& other) const;
            bool operator!=(const ExpressionIterator& other) const;
            bool operator<(const ExpressionIterator& other) const;
            bool operator<=(const ExpressionIterator& other) const;
            bool operator>(const ExpressionIterator& other) const;
            bool operator>=(const ExpressionIterator& other) const;

            ExpressionIterator& operator++();
            ExpressionIterator& operator--();
        };
    public:
        ExpressionIterator begin();
        ExpressionIterator end();
};

std::ostream& operator<<(std::ostream&, const expression);

#define EXPRESSION_PARTIAL_OVERRIDES                                                \
    bool isComplex() const override;                                                \
    bool isEvaluable(const Variables& vars = emptyVars) const override;             \
    bool equals(expression, double precision) const override;                       \
    std::ostream& print(std::ostream&, const bool pretty = false) const override;   \
    std::ostream& postfix(std::ostream&) const override;

#define EXPRESSION_OVERRIDES                                                        \
    EXPRESSION_PARTIAL_OVERRIDES                                                    \
    expression eval(const Variables& vars = emptyVars) override;                    \
    double value(const Variables& vars = emptyVars) const override;


/*
 * Dice Tester - Counter tool to display statistics about the randomness of dice
 */

#include <gsl/gsl_cdf.h>
#include <math.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

int
getSides(int argc, char **argv) {
  int sides = 6;
  if (argc >= 2 && atoi(argv[1]) > 0)
    sides = atoi(argv[1]);
  return sides;
}

double
chiSquared(double *observed, double *expected, int sides) {
  double sum = 0.0;
  for (int i = 0; i < sides; i++)
    sum += pow((observed[i] - expected[i]), 2) / expected[i];
  return sum;
}

int
main(int argc, char **argv)
{
  char input[8];
  int num, total, sides, memSize;
  double *observed, *expected;

  total = 0;

  sides = getSides(argc, argv);
  memSize = sizeof(double) * sides;
  observed = malloc(memSize);
  expected = malloc(memSize);
  printf("HERE %d\n", sides);
  for (int i = 0; i < sides; i++)
    observed[i] = 0.0;

  printf("HERE %d\n", sides);
  printf("Obs: %f\n", observed[0]);
  /* Load observed data */
  while (scanf("%s", input) != EOF) {
    num = atoi(input);

    if (num >= 1 && num <= sides) {
      printf("%d\n", num);
      observed[num-1] += 1;
      total += 1;
    }
    getchar();
  }

  /* Random = flat distribution */
  for (int i = 0; i < sides; i++)
    expected[i] = (double) total / sides;

  double chi2 = chiSquared(observed, expected, sides);
  double pval = 1-gsl_cdf_chisq_P(chi2, sides-1);

  fputs("\n########## RESULTS ##########\n", stderr);
  fputs("Num:\tExp:\tObs:\tPer:\t\n", stderr);
  for (int i = 0; i < sides; i++)
    fprintf(stderr, "%d:\t %2.0f\t %2.0f\t %3.0f%%\n", i+1, expected[i], observed[i], (observed[i] / total)*100);
  if (pval >= 0.1)
    fputs("\nDie is fair :)\n", stderr);
  else if (pval > 0.05)
    fputs("\nDie is probably fair\n", stderr);
  else
    fputs("\nDie not fair :(\n", stderr);

  free(observed);
  free(expected);

  return 0;
}


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

int
main (void)
{
  int N = 4;
  double x[4] = {0.00, 0.10,  0.27,  0.30};
  double y[4] = {0.15, 0.70, -0.10,  0.15};
             /* Note: y[0] == y[3] for periodic data */

  gsl_interp_accel *acc = gsl_interp_accel_alloc ();
  const gsl_interp_type *t = gsl_interp_cspline_periodic;
  gsl_spline *spline = gsl_spline_alloc (t, N);

  int i; double xi, yi;

  printf ("#m=0,S=5\n");
  for (i = 0; i < N; i++)
    {
      printf ("%g %g\n", x[i], y[i]);
    }

  printf ("#m=1,S=0\n");
  gsl_spline_init (spline, x, y, N);

  for (i = 0; i <= 100; i++)
    {
      xi = (1 - i / 100.0) * x[0] + (i / 100.0) * x[N-1];
      yi = gsl_spline_eval (spline, xi, acc);
      printf ("%g %g\n", xi, yi);
    }

  gsl_spline_free (spline);
  gsl_interp_accel_free (acc);
  return 0;
}