P-value functions (Wilcoxon and sign test)

wilcoxP.R

library(ggplot2)
library(dplyr)


wilcox_p <- function(mu,x,prob=0.5){
  x2 <- x-mu
  cmb <- combn(10,2)
  u <-apply(cmb,2,function(i)(x2[i[1]]+x2[i[2]])/2)
  u <- c(u,x2)
  pos <- sum(u>0)
  p1 = pbinom(pos, length(u), prob = prob, lower.tail = FALSE)
  p2 = pbinom(pos, length(u), prob = prob, lower.tail = TRUE)
  data.frame(p = 2*min(p1, p2), location=mu)
}


sign_p <- function(mu, x, prob=0.5){
  x2 <- x-mu
  x2 <- x2[x2 != 0]
  pos <- sum(x2>0)
  p1 = pbinom(pos, length(x2), prob = prob, lower.tail = FALSE)
  p2 = pbinom(pos, length(x2), prob = prob, lower.tail = TRUE)
  data.frame(p = 2*min(p1, p2), location=mu)
}


curve(pweibull(x+log(2)^(1/1.5),1.5),-log(2)^(1/1.5),4)
abline(h=0.5, lty=2)
abline(v=0, lty=2)

set.seed(123);x <- rweibull(50,1.5) - log(2)^(1/1.5)
set.seed(123);x <- rnorm(50)
dfps <- bind_rows(lapply(sort(x), sign_p, x=x))
dfpw <- bind_rows(lapply(sort(x), wilcox_p, x=x))

ggplot(dfps,aes(x=location))+
  geom_rug()+
  geom_step(aes(y=p, colour="sign"))+
  geom_step(data=dfpw, aes(y=p, colour="wilcox"))+
  labs(y="p-value", colour="method")+
  theme_bw(18)+geom_vline(xintercept = 0,linetype=2)

ggsave("pfun_sign.png")