##################################################
#  R code written by:                            #
#                                                #
#  Jimmy A. Doi (jdoi@calpoly.edu)               #
#  Department of Statistics                      #
#  Cal Poly State Univ, San Luis Obispo          #
#  Web: www.calpoly.edu/~jdoi                    #
#                                                #
#  ............................................  #
#                                                #
#  If using please cite:                         #
#                                                #
#  Schilling, M., Doi, J.                        #
#  "A Coverage Probability Approach to Finding   #
#  an Optimal Binomial Confidence Procedure",    #
#  The American Statistician, 68, 133-145.       #
#                                                #
#  ............................................  #
#                                                #
#  Shiny app site:     jdoi.shinyapps.io/LCO-CI  #
#                                                #
#  ............................................  #
#                                                #
#                     Code updated on: 1AUG2014  #
# Huge updates of André GILLIBERT                #
# Optimized algorithm to                         #
# get rid of decimal precision steps             #
##################################################


##############################################################################
#    The function LCO.CI() generates the LCO confidence intervals            #
#    for X = 0, 1, ..., n  for a specified n and confidence level.           #
#                                                                            #
#    Example: To generate all LCO confidence intervals at n=20,              #
#             level=.90, and 3rd decimal place accuracy, use                 #
#                                                                            #
#    > LCO.CI(20,.90,3)                                                      #
##############################################################################

if (0) {
setwd("D:/Documents and Settings/Administrator/My Documents/owncloud/Falissard/ztest")
source("sterne.R")
}

acceptance_conflevel=function(reg, prob,n) {
	pbinom(reg[2],n,prob) - pbinom(reg[1]-1,n,prob)
}

conservative_region=function(lower,upper,n,conf.level=0.95) { # Get the set of theoretical proportions compatible with the specified acceptance interval
	if (lower > upper) {return(c(NA,NA))}
	if (lower > n | upper > n) {
		stop("conservative_region : lower and upper must be below n")
	}
	optifunc=function(prob) {
		pbinom(upper,n,prob) - pbinom(lower-1,n,prob)
	}
	
	lul = qbinom((1-conf.level)/8,n,pmax(0,(lower-3))/n)
	luu = qbinom(1-(1-conf.level)/8,n,pmin(n,(upper+3))/n)
	lu = c(lul, luu)/n # On essaie de circonscrire approximativement la zone dépassant le conf.level. Attention, risque de ne pas marcher si conf.level < 0.50
	if (lower == 0) {
		middle=list(maximum=0,objective=optifunc(0))
	} else if (upper == n) {
		middle=list(maximum=1,objective=optifunc(1))
	} else {
		middle = optimize(f=optifunc,
			lower=lu[1],
			upper=lu[2],
			maximum=T,tol=1e-9/n)
	}
	# plot(sapply(seq(lower,upper,0.01),optifunc))
	if (middle$objective < conf.level) {return(c(NA,NA))}
	middle = middle$maximum
	rootr=function(prob) {
		pbinom(upper,n,prob) - pbinom(lower-1,n,prob) - conf.level
	}
	#lower<<-lower;upper<<-upper;conf.level=conf.level;n<<-n
	if (lower == 0) {
		crlow=0;middle=0;
	} else {
		crlow=uniroot(f=rootr,lower=lu[1],upper=middle,tol=1e-9/n)$root
	}
	if (upper == n) {crup=1;middle=1;} else {
		crup=uniroot(f=rootr,lower=middle,upper=lu[2],tol=1e-9/n)$root
	}
	return(c(crlow,middle,crup))
}
#conservative_region(0,0,64)
#conservative_region(64,64,64)

crmemorize=function(lower,upper,n,conf.level=0.95) {
	l = list()
	function(lower, upper, n, conf.level) {
		key = paste(lower, upper, n, conf.level)
		if (!is.null(l[[key]])) {
			return(l[[key]])
		}
		cr = conservative_region(lower, upper, n, conf.level)
		l[[key]] <<- cr
		cr
	}
}

#conservative_region(0,1,2048,0.95,get.middle=T)
#conservative_region(1,8,2048,conf.level)
#conservative_region(9,25,2048,conf.level)
#system.time(replicate(10000,conservative_region(9,25,2048,conf.level)))


cross_region_montonous=function(reg1, reg2, interval, n, conf.level=0.95) {
	# Find a crossing of confidence curves for acceptance regions reg1 and reg2
	# On an interval where the difference between confidence curves is monotonous
	rootc=function(prob) {
		acceptance_conflevel(reg1, prob, n) - acceptance_conflevel(reg2, prob, n)
	}
	if (sign(rootc(interval[1])) * sign(rootc(interval[2])) > 0) {
		return(NA)
	}
	uniroot(f=rootc,interval=interval,tol=1e-9/n)$root
}
cross_region=function(reg1,reg2,n,conf.level=0.95, pr1=NULL, pr2=NULL) { # Get a cross-point between both curves
	if (is.null(pr1)) {pr1 = conservative_region(reg1[1], reg1[2], n,conf.level)}
	if (is.null(pr2)) {pr2 = conservative_region(reg2[1], reg2[2], n,conf.level)}
	if (is.na(pr1[1]) | is.na(pr2[1])) {return(NULL)}
	if (pr1[1] > pr2[1]) {
		# Get a natural order
		pro = pr1;pr1 = pr2;pr2 = pro;
		rego=reg1;reg1=reg2;reg2=rego;
	}
	if (pr1[3] < pr2[1]) {
		# Empty intersection of coverage region
		return(NULL)
	}
	hotpoints=sort(unique(c(pr1,pr2)))
	hotpoints=hotpoints[hotpoints!=0]
	if (length(hotpoints)<2) {
		return(NULL)
	}
	crosspoints = sapply(1:(length(hotpoints)-1), function (ihotpoint) {
		cross_region_montonous(reg1, reg2, hotpoints[ihotpoint:(ihotpoint+1)], n, conf.level=conf.level)
	})
	as.vector(na.omit(crosspoints))
}
crossmemorize=function() {
	l=list()
	function(reg1, reg2, n, conf.level=0.95, pr1, pr2) {
		if (is.na(pr1[1]) | is.na(pr2[1])) {return(NULL)}
		if (pr1[1] > pr2[1]) {
			# Get a natural order
			pro = pr1;pr1 = pr2;pr2 = pro;
			rego=reg1;reg1=reg2;reg2=rego;
		}
		key=paste(c(reg1,reg2,conf.level),collapse=" ")
		if (!is.null(l[[key]])) {
			return(l[[key]])
		}
		l[[key]] <<- cross_region(reg1,reg2,n,conf.level,pr1,pr2)
		l[[key]]
	}
}


hpoints=function(cpf.matrix,lower,upper,col) {
	mx=subset(cpf.matrix, low==lower & upp==upper)
	lines(x=mx$p,y=rep(0.96,nrow(mx)),col=col)
	abline(v=range(mx$p),col=col)
}

ACcoverage=function(lower,upper,n,prob=seq(0,1,1e-4),conf.level=0.95,add=F,col="black",nocr=F,cpf.matrix=NULL,...) { # lower and upper are integers
	y=pbinom(upper,n,prob) - pbinom(lower-1,n,prob)
	if (add) {plote=lines} else {plote=plot}
	plote(prob,y,type="l",col=col,...)
	if (!add) {abline(h=conf.level)}
	
	if (!nocr) {
		points(x=conservative_region(lower,upper,n,conf.level=conf.level)[c(1,3)],y=rep(conf.level,2),col=col)
	}
	if (!is.null(cpf.matrix)) hpoints(cpf.matrix,lower,upper,col)
}
if (0) {

# ptheo=0.43716, acceptance region [21, 36] vs p=0.4448922
ACcoverage(21,36,64,col="gray",cpf.matrix=acc0d,ylim=c(0.90,1),xlim=c(0.4,0.5))
ACcoverage(20,35,64,col="red",cpf.matrix=acc0d,add=T)
abline(v=0.43716, col="violet")
ACcoverage(20,36,64,col="black",cpf.matrix=acc0d,add=T)

#cross_region(c(20,35), c(21,36),n) # AKONTI
cross_region(acc, oacc, n)

ACcoverage(1,8,2048,col="gray",xlim=c(3,6)/2048,ylim=c(0.90,1),cpf.matrix=m)
ACcoverage(1,9,100,col="gray",xlim=c(0.03,0.10),ylim=c(0.90,1),cpf.matrix=m)
ACcoverage(2,10,100,col="black",xlim=c(0.03,0.10),ylim=c(0.90,1),cpf.matrix=m,add=T)
abline(v=cross_region(c(1,9), c(2,10), 100),col="violet")

#abline(v=0.0534,col="violet");abline(v=0.0588,col="violet")
ACcoverage(2,11,100,col="red",xlim=c(0,0.15),ylim=c(0.90,1),cpf.matrix=m,add=T)
ACcoverage(3,12,100,add=T,col="green",cpf.matrix=m)
ACcoverage(2,12,100,add=T,col="blue",cpf.matrix=m)
ACcoverage(3,13,100,add=T,col="yellow",cpf.matrix=m)
subset(m, low==2 & upp==12)
subset(m, low==8 & upp==22)

ACcoverage(8,21,100,col="black",xlim=c(0.13,0.17),ylim=c(0.948,0.97),cpf.matrix=m)
ACcoverage(9,22,100,col="red",cpf.matrix=m,add=T)
ACcoverage(8,22,100,add=T,col="green",cpf.matrix=m)
ACcoverage(9,23,100,add=T,col="blue",cpf.matrix=m)
}

if (0) {
LCO.sterneACC=function(p,n,level) {
    bin <- dbinom(0:n,n,p)
    x   <- 0:n
    pmf <- cbind(x,bin)

    # Binomial probabilities ordered in descending sequence
    pmf <- pmf[order(-pmf[,2],pmf[,1]),] 
    pmf <- data.frame(pmf)
    
    # Select the endpoints (l,u) such that AC[l,u] will
    # be at least equal to LEVEL. The cumulative sum of
    # the ordered pmf will identify when this occurs.
    m.row  <- min(which((cumsum(pmf[,2])>=level)==TRUE))
    low.val <-min(pmf[1:m.row,][,1])
    upp.val <-max(pmf[1:m.row,][,1])

    c(low.val, upp.val)
}
}
LCO.sterneACC=function(p,n,level) {
    if (!is.finite(p) || !(p>=0 & p<=1)) {
	stop("LCO.sterneACC : p must be between 0 and 1, got : p=",p," n=", n," level=",level)
    }
    if (p == 0) {return(c(0,0))}
    if (p == 1) {return(c(n,n))}
    x   <- qbinom(c(1e-12,1-1e-12),n,p)
    x   <- (x[1]):(x[2])
    bin <- dbinom(x,n,p)
    pmf <- cbind(x,bin)

    # Binomial probabilities ordered in descending sequence
    pmf <- pmf[order(-pmf[,2],pmf[,1]),] 
    pmf <- data.frame(pmf)
    
    # Select the endpoints (l,u) such that AC[l,u] will
    # be at least equal to LEVEL. The cumulative sum of
    # the ordered pmf will identify when this occurs.
    m.row  <- min(which(cumsum(pmf[,2])>=level))
    low.val <-min(pmf[1:m.row,1])
    upp.val <-max(pmf[1:m.row,1])

    c(low.val, upp.val)
}
#LCO.sterneACC(0.4371552056,n,level=conf.level) # 21,36 de justesse
#system.time(replicate(10000, LCO.sterneACC(0.3,2048,0.95)))


LCO.ACC <- function(n,level,dp) { # Sterne Acceptation regions for all theoretical p proportions from 0 to 1 by step of 10^(-dp)

  # For desired decimal place accuracy of dp, search on grid using (dp+1) 
  # accuracy then round final results to dp accuracy.
  iter <- 10**(dp+1)
  
  ############################################################################
  # Create initial cpf with AC[l,u] endpoints by choosing coverage 
  # probability from highest acceptance curve with minimal span.
  
  
  cpf.matrix <- matrix(NA,ncol=3,nrow=iter+1)
  colnames(cpf.matrix)<-c("p","low","upp")
  
  for (i in 1:(iter/2+1)){
    p <- (i-1)/iter
    acc <- LCO.sterneACC(p, n, level=level)

    cpf.matrix[i,] <- c(p,acc)
    
    # cpf flip only for p != 0.5
    
    if (i != iter/2+1){
      n.p <- 1-p
    
      cpf.matrix[iter+2-i,] <- c(1 - p, n - rev(acc))
    }
  }
  cpf.matrix
}



double.cpf.matrix=function(df,n) {
	colnames(df)=c("p","low","upp")
	lsr = df[df$p < 0.50,]
	lsr = data.frame(p=1-lsr$p, low=n-lsr$upp, upp=n-lsr$low)
	rbind(df[df$p <= 0.50,], lsr[nrow(lsr):1,])
}

LCO.ACC2 <- function(n,conf.level=0.95) {
	# Les changements de zone d'acceptation ont lieu à des croisements de ptheo->ACcoverage(lower,upper,n,ptheo) avec la ligne horizontale conf.level ou entre deux régions
	# Quand deux régions d'acceptation se croisent on est censé prendre celle dont le 1-alpha est le plus grand
	# En pratique, ça n'arrive que quand la borne basse d'acceptation baisse d'une unité.
	# Dans ce cas, elle sera ultérieurement remplacée par la zone d'acceptation suivante (pour ptheo légèrement supérieur)
	# Du coup, on peut directement sauter au croisement suivant avec la ligne horizontale conf.level
	mconservative_region = crmemorize() # Version mémorisante de conservative_region
	mcross_region = crossmemorize()
	acc = c(0,0)
	epsilon=1e-4/n
	p = epsilon
	reg0 = conservative_region(acc[1], acc[2], n, conf.level=conf.level)
	ls = NULL
	while (p < 1) {
		ls = c(ls, list(c(p-epsilon,acc)))
		loff =list(c(0,1),c(1,1),c(1,0),c(-1,-1),c(0,-1),c(-1,0))
		regs = lapply(loff, function (offset) {
			oacc = pmin(pmax(acc + offset,c(0,0)), c(n, n))
			if (0) {
			if (all(acc == c(20,35)) & all(oacc == c(21,36)) & p >= 0.430) { # AKONTI
				print(p)
				debinf <<- list(acc=acc, oacc=oacc, reg0=reg0, p=p, epsilon=epsilon,
					mconservative_region  =mconservative_region  ,mcross_region  =mcross_region)
				acc <<- acc;oacc<<-oacc;reg0<<-reg0;p<<-p;n<<-n;epsilon<<-epsilon
				mconservative_region  <<- mconservative_region 
				mcross_region  <<- mcross_region 
				#stop("ok2")
			}
			}
			oreg  = mconservative_region(oacc[1], oacc[2], n, conf.level=conf.level)
			cross = mcross_region(acc, oacc, n, conf.level=conf.level, pr1=reg0, pr2=oreg)
			c(oreg[c(1,3)], cross)
		})
		vpoints = unlist(regs)
		vpoints = na.omit(c(vpoints[vpoints>p], reg0[3]))
		if (is.null(vpoints)) {
			stop("LCO.ACC2 : Cannot find any next acceptance region")
		}
		pnxt = min(vpoints,na.rm=T)
		if (is.null(pnxt) | pnxt>=1) {
			break;
			#stop("Didn't get any definite next acceptance region");
		}
		pnxt = pnxt + epsilon
		acc = LCO.sterneACC(pnxt,n,level=conf.level)
		#LCO.sterneACC(0.4371553,n,level=conf.level)
		# x=seq(0,1,0.001);t(rbind(x,sapply(x, function (x) {LCO.sterneACC(x,n,level=conf.level)})))

		reg0 = conservative_region(acc[1], acc[2], n, conf.level=conf.level)
		p = pnxt
	}
	ls=as.data.frame(do.call(rbind,ls))
	colnames(ls)=c("p","low","upp")
	#double.cpf.matrix(ls,n)
	ls
}
#acc1=LCO.ACC2(64,0.95)

LCO.monotonous2 <- function(cpf.matrix,n) {
	cpf.matrix = dropid(cpf.matrix)
	diff.l <- c(99,diff(cpf.matrix[,2],differences = 1))
  
	for (i in which(diff.l==-1)) {
		cpf.matrix[i,2:3]=cpf.matrix[i+1,2:3]
	}
	dropid(cpf.matrix)
}
gmget=function(p,gm) {
	gm=as.data.frame(m)
	colnames(gm)=c("p","low","upp")
	gm[max(which(gm$p <= p)),2:3]
}

dropid=function(m) {
	m = as.data.frame(m[!duplicated(m[,2:3]),])
	colnames(m)=c("p","low","upp")
	m
}

if (0) {
m=as.data.frame(LCO.ACC(100,0.95,3));
m2=LCO.monotonous(m,3)
unique(paste(m[,2],m[,3]))
unique(paste(m2[,2],m2[,3]))
gm=LCO.ACC2(100,0.95)
gm=LCO.monotonous2(gm)
m3=dropid(m2);rownames(m3)=NULL
gm=dropid(gm);rownames(gm)=NULL
gm$p=ceiling(gm$p*1e4)/1e4
all(m3[60:70,] == gm[60:70,])
cbind(m3[60:70,],gm[60:70,])

gmget(0.49,dropid(gm))
100-rev(gmget(1-0.49,dropid(gm)))

gmget(0.49,dropid(m))
100-rev(gmget(1-0.49,dropid(m)))

gmget(0.49,dropid(m2))
100-rev(gmget(1-0.49,dropid(m2)))
}

ACC2CI=function(cpf.matrix,n) {
	# ACC2CI gets a monotonous acceptance function as produced by LCO.monotonous2(LCO.ACC2(100,0.95),100)
	# And returns a confidence interval set (matrix (n+1)x2)

	ci.matrix <-  matrix(NA,ncol=3,nrow=n+1) 
	rownames(ci.matrix) <- c(rep("",nrow(ci.matrix)))
	colnames(ci.matrix) <- c("x","lower","upper")

	x.limit <- n%/%2

	for (x in 0:x.limit) {
		ok = range(which(x >= cpf.matrix$low & x <= cpf.matrix$upp))
		ok[2]=ok[2]+1

		ci = cpf.matrix$p[ok]
		ci.matrix[x+1,]<-c(x,ci)
		ci.matrix[n - x+1,]<-c(n - x,1 - rev(ci))
	}
	ci.matrix
}


#cpf.matrix=LCO.monotonous2(LCO.ACC2(n,conf.level),n)
#ACC2CI(cpf.matrix,n)
LCO.CI2=function(n,conf.level=0.95) {
	ACC2CI(LCO.monotonous2(LCO.ACC2(n,conf.level),n),n)
}

matrix2CI=function(cpf.matrix,n) {
	as.data.frame(ACC2CI(LCO.monotonous2(cpf.matrix,n),n))
}

LCO.monotonous=function(cpf.matrix,dp) {
  iter <- 10**(dp+1)
  ############################################################################
  # LCO Gap Fix
  # If the previous step yields any violations in monotonicity in l for 
  # AC[l,u], this will cause a CI gap. Apply fix as described in Step 2 of 
  # algorithm as described in paper.

  # For p < 0.5, monotonicity violation in l can be determined by using the 
  # lagged difference in l. If the lagged difference is -1 a violation has 
  # occurred. The NEXT lagged difference of +1 identifies the (l,u) pair to 
  # substitute with. The range of p in violation would be from the lagged 
  # difference of -1 to the point just before the NEXT lagged difference of 
  # +1. Substitute the old (l,u) with updated (l,u) pair. Then make required
  # (l,u) substitutions for corresponding p > 0.5. 
  
  # Note the initial difference is defined as 99 simply as a place holder.
  
  diff.l <- c(99,diff(cpf.matrix[,2],differences = 1))
  
  if (min(diff.l)==-1){
  
    for (i in which(diff.l==-1)){
      j <- min(which(diff.l==1)[which(diff.l==1)>i])
      new.low <- cpf.matrix[j,2]
      new.upp <- cpf.matrix[j,3]
      cpf.matrix[i:(j-1),2] <- new.low
      cpf.matrix[i:(j-1),3] <- new.upp
      }
   
    # cpf flip
    pointer.1 <- iter - (j - 1) + 2
    pointer.2 <- iter - i + 2
    
    cpf.matrix[pointer.1:pointer.2,2]<- n - new.upp
    cpf.matrix[pointer.1:pointer.2,3]<- n - new.low
  }
  cpf.matrix
}
LCO.CI <- function(n,level,dp)
{

  # For desired decimal place accuracy of dp, search on grid using (dp+1) 
  # accuracy then round final results to dp accuracy.
  iter <- 10**(dp+1)
  
  cpf.matrix <- LCO.ACC(n,level,dp)

  cpf.matrix <- LCO.monotonous(cpf.matrix,dp)
    
  ############################################################################
  # LCO CI Generation
  
  ci.matrix <-  matrix(NA,ncol=3,nrow=n+1) 
  rownames(ci.matrix) <- c(rep("",nrow(ci.matrix)))
  colnames(ci.matrix) <- c("x","lower","upper")
  
  # n%%2 is n mod 2: if n%%2 == 1 then n is odd
  # n%/%2 is the integer part of the division: 5/2 = 2.5, so 5%/%2 = 2
  
  if (n%%2==1) x.limit <- n%/%2
  if (n%%2==0) x.limit <- n/2
  
  for (x in 0:x.limit)
  {
    num.row <- nrow(cpf.matrix[(cpf.matrix[,2]<=x & x<=cpf.matrix[,3]),])

    low.lim <- 
      round(cpf.matrix[(cpf.matrix[,2]<=x & x<=cpf.matrix[,3]),][1,1],
            digits=dp)

    upp.lim <- 
      round(cpf.matrix[(cpf.matrix[,2]<=x & x<=cpf.matrix[,3]),][num.row,1],
            digits=dp)

    ci.matrix[x+1,]<-c(x,low.lim,upp.lim)
    
    # Apply equivariance
    n.x <- n-x
    n.low.lim <- 1 - upp.lim
    n.upp.lim <- 1 - low.lim
    
    ci.matrix[n.x+1,]<-c(n.x,n.low.lim,n.upp.lim)
  }
  
  
  heading <- matrix(NA,ncol=1,nrow=1)    
  
  heading[1,1] <- 
    paste("LCO Confidence Intervals for n = ",n," and Level = ",level,sep="")
  
  rownames(heading) <- c("")
  colnames(heading) <- c("")
  
  print(heading,quote=FALSE)
  
  print(ci.matrix)
}


##############################################################################
#    The function LCO.CI() generates the LCO confidence intervals            #
#    for X = 0, 1, ..., n  for a specified n and confidence level.           #
#                                                                            #
#    Example: To generate all LCO confidence intervals at n=20,              #
#             level=.90, and 3rd decimal place accuracy, use                 #
#                                                                            #
#    > LCO.CI(20,.90,3)                                                      #
##############################################################################


if (0) {
#system.time(ci1<<-LCO.CI(99,0.95,4))
#system.time(ci2<<-LCO.CI2(99,0.95))
#write.table(ci1,"Schilling-Doi_n100_dp5.csv",sep=";",dec=",",row.names=F)
saferound=function(mci,digits=5) {
	cst=10**digits
	mci[,2]=floor   (mci[,2]*cst)/cst
	mci[,3]=ceiling (mci[,3]*cst)/cst
	mci
}
saferound(ci2,5)-ci1
cbind(ci1,ci2,(round(ci2,5)-ci1))

system.time(ci2<<-LCO.CI2(1000,0.95))
}

if (0) {
# bug : inconsistency between old and new methods
system.time(acc0<<-LCO.ACC(64,0.95,dp=4))
acc1=LCO.ACC2(64,0.95)
cbind(head(dropid(round(acc0,5)),20), head(dropid(pceiling(acc1,1e-5)),20))
cbind(head(dropid(round(acc0,5)),-20), head(dropid(pceiling(acc1,1e-5)),-20))

acc0d=dropid(acc0)
acc1d=dropid(acc1)
idx=which(abs(acc0d[,1]-acc1d[,1])>1e-3)
cbind(acc0d,acc1d)[idx-1,]
cbind(acc0d,acc1d)[idx,]

acc0b=as.matrix(LCO.monotonous2(acc0))
acc1b=as.matrix(LCO.monotonous2(acc1))
summary(acc0b[,1]-acc1b[,1])
idx=which(abs(acc0b[,1]-acc1b[,1])>1e-3)
cbind(acc0b,acc1b)[idx,]

m64a=matrix2CI(acc0b,64)
m64b=matrix2CI(acc1b,64)
summary(m64a$lower-m64a$lower)
summary(m64a$upper-m64b$upper)

all(0 == round(dropid(round(acc0,5)) - dropid(pceiling(acc1,1e-5))))
}

if (0) {
m64 =as.data.frame(LCO.CI(64,0.95,5))
m64b=as.data.frame(LCO.CI2(64,0.95))
mean(m64b$upper-m64b$lower)
mean(m64a$upper-m64a$lower)
mean(m64$upper-m64$lower)
}

