Confidence interval via Wilcoxon and sign test

ciplot.r

library(ggplot2)

binomfun <- function(c,n){
  sum(choose(n,floor(n/2+seq(-c,c)))/(2^n))
}

wilcoxCI <- function(x,level){
  xx <- outer(x,x,"+")
  u <- sort(xx[lower.tri(xx, diag = TRUE)]/2)
  n <- length(u)
  alpha_c = sapply(1:(n/2), binomfun, n=n)
  k <- which.max(alpha_c-(level)>0)
  lower <- u[k]
  upper <- u[n-k+1]
  return(c(lower,upper))
}

signCI <- function(x,level){
  n <- length(x)
  sx <- sort(x)
  alpha_c = sapply(1:(n/2), binomfun, n=n)
  k <- which.max(alpha_c-(level)>0)
  lower <- sx[k]
  upper <- sx[n-k+1]
  return(c(lower,upper))
}

levs <- seq(0.01,0.99,length.out=101) 

set.seed(15); x <- rlogis(15)
ci_w <- t(sapply(levs, function(a)wilcoxCI(x,a)))
ci_s <- t(sapply(levs, function(a)signCI(x,a)))

p1 <- ggplot(data = NULL, aes(x=x))+
  geom_rug()+
  geom_path(aes(x=ci_w[,1], y=levs, colour="wilcox"))+
  geom_path(aes(x=ci_w[,2], y=levs, colour="wilcox"))+
  geom_path(aes(x=ci_s[,1], y=levs, colour="sign"))+
  geom_path(aes(x=ci_s[,2], y=levs, colour="sign"))+
  theme_bw()+labs(y="alpha", colour="CI")+
  scale_color_brewer(palette = "Set2")

print(p1)
ggsave(p1, filename = "ci_np.png")