* Encoding: UTF-8.

* TITLE : Clopper-Pearson mid-P interval.
* AUTHOR : André GILLIBERT (August 2017)
* LICENSE : Creative Commons CC0
* PROGRAMMING LANGUAGE : SPSS Syntax (tested on SPSS 16 and SPSS 25)
* SYNTAX :
* cp midp varname=<variable name of the active dataset> conf=<confidence level>
* There is no space between cp and midp, but due to the SPSS feature/bug of executing macro inside comments, it had to be added.
* EXAMPLE : 
* cp midp varname=complication conf=0.95.
* DESCRIPTION : Implements the Clopper-Pearson mid-P confidence interval of a binomial proportion
* This interval is described in DOI: 10.2307/2348891
* A variable name of the active dataset must be specified (varname).
* This variable must contain 0 and 1 numeric values. Missing values are excluded.
* The confidence level must be specified. It's a real number between 0 and 1.

define cpmidp(varname = !TOKENS(1) / conf = !TOKENS(1)).
dataset name OriginalData.

* We create a dataset named 'temp' with one row and two columns: successes=number of successes and trials=number of trials.

dataset declare temp window=hidden.
temporary.
compute always1=1.
aggregate outfile=temp /break=always1 / successes=sum(!varname) / trials=N(!varname).
dataset activate temp.

* We are going to execute the procedure on the one-row dataset.
* The hard work will be done with scrap variables.

compute #conf=!conf.
loop #bound=0 to 1.
    compute #target = 0.5 - (#bound*2-1)*#conf/2.
    compute #x=successes.
    compute #n=trials.
    compute #xlower = 0.
    compute #xupper = 1.
    compute #flower=CDF.BINOM(#x,#n,#xlower)-PDF.BINOM(#x,#n,#xlower)/2 - #target.
    compute #fupper=CDF.BINOM(#x,#n,#xupper)-PDF.BINOM(#x,#n,#xupper)/2 - #target.
    compute #prec=1e-8/#n.
    
    loop.
    compute #xmid = (#xlower+#xupper)/2.
    compute #fmid=CDF.BINOM(#x,#n,#xmid)-PDF.BINOM(#x,#n,#xmid)/2 - #target.
    do if ((#fmid)*(#flower) > 0).
        compute #xlower = #xmid.
        compute #flower = #fmid.
    else.
        compute #xupper = #xmid.
        compute #fupper = #fmid.
    end if.
    end loop if ((#xupper - #xlower) < #prec).
    
    compute #xmid = (#xupper+#xlower)/2.
do if (#bound = 0).
    do if (#x = 0).
        compute #xmid=0.
    end if.
    compute lower_cl=#xmid.
else.
    do if (#x = #n).
        compute #xmid=1.
    end if.
    compute upper_cl=#xmid.
end if.
end loop.
compute conf=#conf.
execute.
formats lower_cl upper_cl (F10.8).
list / cases=1 .
dataset close temp.
dataset activate originaldata.
!enddefine.

