/* This file provides two macros  :
   cpmidp : Computes the Clopper-Pearson mid-P confidence interval from an immediate number of successes and trials
   cpmidp_varbin : Computes the Clopper-Pearson mid-P confidence interval from a binary variable in a dataset
 */
%macro cpmidp(
	x,
	n,
	conf_level=0.95,
	prec=1e-8/n,
	print=1,
	out=);
/*
	AUTHOR    : André GILLIBERT (August 2017)
	LICENSE   : Creative Commons CC0
	FUNCTION  : Computes the Clopper-Pearson mid-P confidence interval of a binomial proportion
	REFERENCE : Berry and Armitage. Mid-P confidence intervals: a brief review.
				Journal of the Royal Statistical Society Series D (The Statistician) 44(4). January 1995.
				DOI: 10.1371/journal.pone.0045723

	MANDATORY PARAMETERS:
		x = number of successes
		n = number of trials
	OPTIONAL PARAMETERS:
		conf_level	= two-sided confidence level
		prec		= Decimal precision of the confidence bounds requested.
		print		= 1 if the confidence limits should be printed to the Output Display System
		out			= Name of a dataset containing the confidence limits, retained after procedure exit
*/
%let out2 = &out;
%if &out2 = %then %do;
	%let out2 = temp;
%end;
data &out2;
	retain x n estimate trials lcl ucl conf_level;
	x=&x;n=&n;
	if x = 0 then out=0; else do;
		target=(0.5+&conf_level/2);
		xlower=0;xupper=x/n;
		%datastep_uniroot(upvalue_cp_midp,target,prec=&prec);
	end;
	lcl = out;
	if x = n then out=1; else do;
		target=(0.5-&conf_level/2);
		xlower=x/n;xupper=1;
		%datastep_uniroot(upvalue_cp_midp,target,prec=&prec);
	end;
	ucl = out;
	Estimate = x/n;
	conf_level=&conf_level;

	keep x n estimate lcl ucl conf_level;
run;
data &out2;
	set &out2;
	attrib lcl label="Lower confidence limit (CP mid-P)";
	attrib ucl label="Upper confidence limit (CP mid-P)";
	attrib x label="Successes";
	attrib n label="Trials";
	attrib conf_level label="Two-sided confidence level";
run;
%if &print = 1 %then %do;
proc print data=&out2 label noobs;run;
%end;
%if &out = %then %do;
	proc datasets noprint library=work;
		delete &out2;
	quit;
%end;
%mend;


%macro cpmidp_varbin(
	data,
	varbin,
	conf_level=0.95,
	print=1,
	out=);
/*
	cpmidp_varbin : It's the same internal function as cpmidp but it works from
	a dataset with a binary variable. Missing values are excluded.
	Successes are non-zero non-missing values. Trials are any non-missing values.

	MANDATORY PARAMETERS:
		data = Name of the dataset
		varbin = Name of a numeric variable in the dataset (0 values are failures, other non-missing values are successes)
	OPTIONAL PARAMETERS:
		conf_level = confidence level (from 0 to 1)
		print = 1 to print results to the Output Display System or 0 to keep the procedure quiet
		out = name of an output dataset where the results will be stored
*/

data _tmpData;
	length _xvalue 3;
	set &data;
	if missing(&varbin) then delete; else _xvalue = &varbin ne 0;
	keep _xvalue;
run;

%let x=;
%let n=;
proc sql noprint;
	select sum(_xvalue) into :x from _tmpData;
	select count(_xvalue) into :n from _tmpData;
quit;
%cpmidp(&x,&n,conf_level=&conf_level,print=&print,out=&out);
proc datasets library=work noprint;
	delete _tmpData;
quit;
%mend;

%macro upvalue_cp_midp(p,context);
	xm = x - 1;
	if (xm < 0) then xm=0; else xm=PROBBNML(&p,n,xm);
	out = PROBBNML(&p,n,x)-(PROBBNML(&p,n,x)-xm)/2 - &context;
	pvalue=out + &context;
%mend;

%macro datastep_uniroot(zeromac,context,nit=10,prec=1e-6);
	/* zeromac must take an argument and output the result in the 'out' numeric variable */
	/* On entry : xlower and xupper must be set */
	%&zeromac(xlower,&context)
	flower=out;
	%&zeromac(xupper,&context)
	fupper=out;

	if (sign(flower)*sign(fupper)>0) or (xlower > xupper) then do;
		out=.;
	end; else do;
		do while ((xupper - xlower) > (&prec));
		xmid = (xlower + xupper)/2;
		%&zeromac(xmid,&context)
		fmid =out;

		if sign(fmid)*sign(flower) > 0 then do;
			xlower = xmid; flower=fmid;
		end; else do;
			xupper = xmid; fupper=fmid;
		end;
		out = (xlower + xupper)/2;
		end;
	end;
%mend;

