#include <stdio.h>
#include <math.h>
#include "gpk_std.h"
#include "numerics.h"
#include "gpkieee754.h"


#define D if(0)


/* Integral of exp(-c*x*x) from a to b */
double eim(double a, double b, double c)
{
 D fprintf(stderr, "eim from %g to %g, with coef=%g\n", a, b, c);
 C double rc = sqrt(-c);
 b *= rc;
 a *= rc;
 C double cc = sqrt(M_PI)/2;
 D fprintf(stderr, "eim from %g to %g, with coef=%g rc=%g\n", a, b, c, rc);
 if(a>1 && b>1)
	return cc*(erfc(a) - erfc(b))/rc;
 else if(a<-1 && b<-1)
	return cc*(erfc(-b) - erfc(-a))/rc;

 return cc*(erf(b) - erf(a))/rc;
}



/* integral of exp(c*x) from a to b */
double eip(double a, double b, double c)
{
 C double w = b-a;
 if(fabs(c*w) < 1e-6)
	return exp(c*0.5*(a+b))*(w + w*w*w*c*c/3);
 return (exp(c*b)-exp(c*a))/c;
}






extern "C"
struct parab_t expint_parab(double a, double fa, double b, double fb, double c, double fc)
{
 C double r = b-a;
 C double w = c-a;
 C double fr = fb-fa;
 C double fw = fc-fa;

 parab_t rv;

 rv.coef = (fr*w-fw*r)/(r*r*w - w*w*r);
 rv.slope = (fr*w*w - fw*r*r)/(r*w*w - w*r*r);
 rv.xctr = a - rv.slope/(2*rv.coef);
 rv.yctr = fa - rv.slope*rv.slope/(4*rv.coef);
 rv.value = fa;

 return rv;
}




/* Integral of exp(y), with xm, and xp as anchor points. Integral starts at low,
and goes to 0.5*(x0+xp). */

LOCAL
double expint_guts(double low, double high,
			double xm, double ym,
			double x0, double y0,
			double xp, double yp)
{
 D fprintf(stderr, "elocal(%g, %g, %g, %g, %g, %g) from %g to %g\n",
			xm, ym, x0, y0, xp, yp, low, high);
 C parab_t p = expint_parab(x0, y0, xm, ym, xp, yp);
 D fprintf(stderr, "fit with parab ctr=%g max=%g coef=%g\n", p.xctr, p.yctr, p.coef);
 if(finite(p.coef) && finite(p.xctr) && finite(p.yctr) && p.coef < 0  && fabs(p.xctr)<4*fabs(high-low))
	return eim(low-p.xctr, high-p.xctr, p.coef) * exp(p.yctr);

 D fprintf(stderr, "slope for eip=%g, exp(y0)=%g\n", (yp-ym)/(xp-xm), exp(y0));
 return eip(low-x0, high-x0, (yp-ym)/(xp-xm)) * exp(y0);
}


extern "C"
double expint_end(double low, double xm, double ym,
			double x0, double y0, double xp, double yp)
{
 C double high = 0.5*(xm+x0);
 D fprintf(stderr, "\texpint_end: low=%g high=%g\n", low, high);
 return expint_guts(low, high, xm, ym, x0, y0, xp, yp);
}



/* Integral of exp(y), with xm, and xp as anchor points. */

extern "C"
double expint_local(double xm, double ym, double x0, double y0, double xp, double yp)
{
 C double low = 0.5*(xm+x0);
 C double high = 0.5*(xp+x0);
 return expint_guts(low, high, xm, ym, x0, y0, xp, yp);
}


