#include <stdio.h>
#include "config.h"
#include "nmath.h" /* includes config.h, math.h */
#include "dpq.h"



#ifdef Z80CC
#define RTOL 1.0e-4
#else
#define RTOL 1.0e-8
#endif

double pbeta(double x, double a, double b, int lower_tail, int log_p);
double dbinom(double x,double n,double p);
double pbinom(double x, double n, double p);

#ifdef DEBUG
static int midpcnt=0;
#endif
double midptest(double p, void *info) {
	struct midptestcontext *ctx = info;

#ifdef DEBUG
	midpcnt ++;
	printf(
	"%f %f %f : (%f %f %f) %f\n",
		ctx->x, ctx->n, p,
		pbinom(ctx->x, ctx->n, p),
		dbinom(ctx->x, ctx->n, p),
		ctx->q,
		(pbinom(ctx->x-1, ctx->n, p)+0.5*dbinom(ctx->x, ctx->n, p) - (ctx->q)) );
#endif
	return pbinom(ctx->x-1, ctx->n, p)+0.5*dbinom(ctx->x, ctx->n, p) - (ctx->q);
}
static double cube(double x) {return x*x*x;}
double pratt_upper(double x, double n, double conf, int overestimate) {
	double kappa, kappa2;
	double xnx;
	double xp1;
	double r;
	double epsilon;
	double num;
	double denom;
	double one=1.0;
	/* classical Clopper-Pearson */
	if (x<0) {x=0;}
	if (x==n) {return(1.0);}
	if (fabs(conf - 0.90)<1e-5) {kappa=1.644854;}
	else if (fabs(conf - 0.95)<1e-5) {kappa=1.959964;}
	else if (fabs(conf - 0.99)<1e-5) {kappa=2.575829;}
	else if (fabs(conf - 0.98)<1e-5) {kappa=2.326348;}
	else if (fabs(conf - 0.80)<1e-5) {kappa=1.281552;}
	else return (overestimate ? 1.0:(x/((double)n)));
	kappa2 = kappa*kappa;
	xp1 = x+one;
	
	num = (81*xp1*(n-x)-9*n-8-3*kappa*sqrt(9*xp1*(n-x)*(9*n+5-kappa2)+n+1));
	denom = (81*xp1*xp1-9*xp1*(2+kappa2)+1);
	xnx = (xp1/(n-x));
	r = 1.0/(1.0 + xnx*xnx*cube(num / denom));
	r += (overestimate ? 0.1/((double)n) : -0.1/((double)n));
	if (r >= 1.0) {r=1.0;}
	if (r <= 0.0) {r=0.0;}
	
	if (x < 5.0 || (n-x)<5.0) {epsilon=0.05;} else {epsilon=0.0;}
	if (r > 0.5) {
		r = one - r; /* 1.0 - r is buggy on Z80CC, but it works through a variable 'one' containing 1.0 */
		if (overestimate) {epsilon = (one-epsilon);} else {epsilon=(one+epsilon);}
		r *= epsilon;
		r = one - r;
	} else {
		if (overestimate) {epsilon = (one+epsilon);} else {epsilon=(one-epsilon);}
		r = r*epsilon;
	}
	if (r >= 1.0) {r=1.0;}
	if (r <= 0.0) {r=0.0;}
	return r;
}
double cpmidq(double x, double n, double q) {
	struct midptestcontext ctx;
	double a,b;
	int Maxit=1000;
	double tol=RTOL/((double)n);
	double fa, fb;
	double r;
#ifdef DEBUG
	printf("cpmidq1 %f %f %f\n", x, n, q);
#endif
	/*if ((q*n - 0.50)*(x/n - 0.50) < 0) return 1-cpmidq(n-x,n,1-q);*/
	if (x > 0.5*n) {
		return 1.0-cpmidq(n-x,n,1.0-q);
	}
	
	ctx.x = x;
	ctx.n = n;
	ctx.q = q;
	
	if (q < 0.5) {
#ifdef DEBUG
		printf("1. Going to pratt_upper %f %f %f and %f\n", x, n, 1-4*q, 1-2*q);
#endif
		a = pratt_upper(x,n,1-4*q, 0);
		b = pratt_upper(x,n,1-2*q, 1);
	} else {
		double alpha = 2*(1-q);
#ifdef DEBUG
		printf("2. Going to pratt_upper %f %f %f and %f\n", x, n, 1-2*alpha, 1-alpha);
#endif
		b = 1-pratt_upper(n-x,n,1-2*alpha, 0);
		a = 1-pratt_upper(n-x,n,1-alpha, 1);
	}
#ifdef DEBUG
	printf("Must be between %f and %f (bound %f)\n", a, b, q);
#endif
/*
	#ifdef DEBUG
	fa=midptest(a, &ctx);
	fb=midptest(b, &ctx);
	printf("cpmidq2 %f %f %f [%f %f]\n", x, n, q, fa, fb);
#endif
*/
	r = zeroin(a, b, &ctx, &tol);
	if (ISNAN(r) || r < 0) {
		printf("==========failure=========\n");
		a=((q > 0.50)?0.0:(x/n));
		b=((q < 0.50)?1.0:(x/n));
		r = zeroin(a, b, &ctx, &tol);
	}
	return r;
}
void cpmidp(double x, double n, double conf, double *lower, double *upper) {
	double up = 0.5+conf*0.5;
	if (x > 0.5*n) {
		double tmp;
		cpmidp(n-x,n,conf,lower,upper);
		tmp = *lower;
		*lower = 1-*upper;
		*upper = 1-tmp;
		return;
	}
#ifdef DEBUG
	printf("cpmidp %f %f %f\n", x, n, conf);
#endif
	if (x == n) {*upper = 1;} else {*upper = cpmidq(x,n,1-up);} /* 0.5-conf*0.5 is buggy (returns -0.025) with the Z88DK compiler: the workaround is to compute 1-up */
	if (x == 0) {*lower = 0;} else {*lower = cpmidq(x,n,up);}
	return;
}
int main(int argc, char **argv) {
	double lower=NAN, upper=NAN;
	char *pname = "cpmidp";
	double conf=0.95;
	double x=0.0;
	double n=1.0;
	int i;

	if (argc!=3 && argc!=4) {
		fprintf(stderr, "%s expects two or three arguments : <number of successes> <number of trials> [<confidence level>]\n",pname);
		return 1;
	}

	x=atof(argv[1]);
	n=atof(argv[2]);
	if (argc >= 4) {conf=atof(argv[3]);}
	if (!(n>=1.0 && floor(n) == n && isfinite(n))) {
		fprintf(stderr, "%s expects integer number of trials >=1\n",pname);
		return 2;
	}
	if (!(x>=0.0 && floor(x) == x && x <= n)) {
		fprintf(stderr, "%s expects integer number of successes >=1 and <= n\n",pname);
		return 2;
	}
	if (!(conf > 0.0 && conf < 1.0)) {
		fprintf(stderr, "%s expects a confidence level > 0 and < 1\n",pname);
		return 2;
	}
#ifdef DEBUG
	printf("CP-midP confidence interval for %f / %f\n", x, n);
#endif
	cpmidp(x,n,conf,&lower, &upper);
#ifdef Z80CC
	printf("[%f ; %f]\n", lower, upper);
#else
	printf("[%.10g ; %.10g]\n", lower, upper);
#endif
#ifdef DEBUG
	printf("N. Ops : %d\n", midpcnt);
#endif
	return 0;
}
