Confidence interval of odds ratio (with no conflict to p-value)

fisherCI.R

#https://okumuralab.org/~okumura/stat/2by2.html

library(MCMCpack)

confint_fisher <- function(X, level=0.95){
  rs <- rowSums(X)
  cs <- colSums(X)
  alpha <- 1-level
  testfun_up <- function(phi){
    pall <- MCMCpack::dnoncenhypergeom(x = NA, cs[1],cs[2],rs[1], exp(phi))
    i <- match(X[1,1],pall[,1])
    pv <- sum(pall[i:nrow(pall),2])
    pv-alpha/2
  }
  testfun_low <- function(phi){
    pall <- MCMCpack::dnoncenhypergeom(x = NA,
                                       cs[1],cs[2],rs[1], exp(phi))
    i <- match(X[1,1],pall[,1])
    pv <- sum(pall[1:i,2])
    pv-alpha/2
  }
  res_u <- uniroot(testfun_up, lower = -10, upper = 10)
  res_l <- uniroot(testfun_low, lower = -10, upper = 10)
  list(oddsratio=c(exp(res_u$root),exp(res_l$root)))
}

confint_fisher2 <- function(X, level=0.95){
  rs <- rowSums(X)
  cs <- colSums(X)
  alpha <- 1-level
  testfun<- function(phi){
    pall <- MCMCpack::dnoncenhypergeom(x = NA,
                                       cs[1],cs[2],rs[1], exp(phi))
    i <- match(X[1,1],pall[,1])
    pv <- sum(pall[pall[,2]<pall[i,2],2])+pall[i,2]
    pv-alpha
  }
  
  x <- seq(-10, 10, by=0.01)
  pi <- sapply(x, testfun)

  r <- range(which(pi>0))

  list(oddsratio=c(exp(x[r[1]]),exp(x[r[2]])))
}

X <-matrix(c(12,5,6,12), nrow=2)

resf <- fisher.test(X, conf.level = 0.95)
print(resf$conf.int)
print(confint_fisher(X))
print(confint_fisher2(X))