library(metafor)

##############################
pb.hybrid.nonbinary <- function(y, s2, n = NA, methods = "reg", iter.resam = 1000, theo.pval = TRUE){
  pval.rank <- pval.reg <- pval.reg.het <- pval.skew <- pval.skew.het <- pval.inv.sqrt.n <- pval.trimfill <- NA
  pval.rank.theo <- pval.reg.theo <- pval.reg.het.theo <- pval.skew.theo <- pval.skew.het.theo <- pval.inv.sqrt.n.theo <- pval.trimfill.theo <- NA
  if(is.element("rank", methods)){
    rank <- pb.rank(y, s2)
    stat.rank <- rank$stat
    if(theo.pval) pval.rank.theo <- rank$pval
  }
  if(is.element("reg", methods)){
    reg <- pb.reg(y, s2)
    stat.reg <- reg$stat
    if(theo.pval) pval.reg.theo <- reg$pval
  }
  if(is.element("reg.het", methods)){
    reg.het <- pb.reg.het(y, s2)
    stat.reg.het <- reg.het$stat
    if(theo.pval) pval.reg.het.theo <- reg.het$pval
  }
  if(is.element("skew", methods)){
    skew <- pb.skew(y, s2)
    stat.skew <- skew$stat
    if(theo.pval) pval.skew.theo <- skew$pval
  }
  if(is.element("skew.het", methods)){
    skew.het <- pb.skew.het(y, s2)
    stat.skew.het <- skew.het$stat
    if(theo.pval) pval.skew.het.theo <- skew.het$pval
  }
  if(is.element("inv.sqrt.n", methods)){
    inv.sqrt.n <- pb.inv.sqrt.n(y, s2, n)
    stat.inv.sqrt.n <- inv.sqrt.n$stat
    if(theo.pval) pval.inv.sqrt.n.theo <- inv.sqrt.n$pval
  }
  if(is.element("trimfill", methods)){
    options(warn = -1)
    rma <- rma(yi = y, vi = s2, method = "DL")
    trimfill <- pb.trimfill(rma, estimator = "R0")
    stat.trimfill <- trimfill$k0
    if(theo.pval) pval.trimfill.theo <- trimfill$pval
    options(warn = 0)
  }

  N <- length(y)
  w <- 1/s2
  theta.hat <- sum(w*y)/sum(w)
  Q <- sum(w*(y - theta.hat)^2)
  tau2.hat <- (Q - N + 1)/(sum(w) - sum(w^2)/sum(w))
  tau2.hat <- max(c(0, tau2.hat))
  w <- 1/(s2 + tau2.hat)
  theta.hat <- sum(w*y)/sum(w)
  if(all(is.na(n))) n <- rep(NA, N)

  stat.rank.resam <- stat.reg.resam <- stat.reg.het.resam <- stat.skew.resam <- stat.skew.het.resam <-
    stat.inv.sqrt.n.resam <- stat.trimfill.resam <- stat.hybrid.resam <- stat.hybrid.theo.resam <- rep(NA, iter.resam)
  pval.rank.theo.resam <- pval.reg.theo.resam <- pval.reg.het.theo.resam <- pval.skew.theo.resam <- pval.skew.het.theo.resam <-
    pval.inv.sqrt.n.theo.resam <- pval.trimfill.theo.resam <- rep(NA, iter.resam)
  for(i in 1:iter.resam){
    idx <- sample(1:N, replace = TRUE)
    s2.resam <- s2[idx]
    n.resam <- n[idx]
    y.resam <- rnorm(n = N, mean = theta.hat, sd = sqrt(s2.resam + tau2.hat))
    if(is.element("rank", methods)){
      rank.resam <- pb.rank(y.resam, s2.resam)
      stat.rank.resam[i] <- rank.resam$stat
      if(theo.pval) pval.rank.theo.resam[i] <- rank.resam$pval
    }
    if(is.element("reg", methods)){
      reg.resam <- pb.reg(y.resam, s2.resam)
      stat.reg.resam[i] <- reg.resam$stat
      if(theo.pval) pval.reg.theo.resam[i] <- reg.resam$pval
    }
    if(is.element("reg.het", methods)){
      reg.het.resam <- pb.reg.het(y.resam, s2.resam)
      stat.reg.het.resam[i] <- reg.het.resam$stat
      if(theo.pval) pval.reg.het.theo.resam[i] <- reg.het.resam$pval
    }
    if(is.element("skew", methods)){
      skew.resam <- pb.skew(y.resam, s2.resam)
      stat.skew.resam[i] <- skew.resam$stat
      if(theo.pval) pval.skew.theo.resam[i] <- skew.resam$pval
    }
    if(is.element("skew.het", methods)){
      skew.het.resam <- pb.skew.het(y.resam, s2.resam)
      stat.skew.het.resam[i] <- skew.het.resam$stat
      if(theo.pval) pval.skew.het.theo.resam[i] <- skew.het.resam$pval
    }
    if(is.element("inv.sqrt.n", methods)){
      inv.sqrt.n.resam <- pb.inv.sqrt.n(y.resam, s2.resam, n.resam)
      stat.inv.sqrt.n.resam[i] <- inv.sqrt.n.resam$stat
      if(theo.pval) pval.inv.sqrt.n.theo.resam[i] <- inv.sqrt.n.resam$pval
    }
    if(is.element("trimfill", methods)){
      options(warn = -1)
      rma.resam <- rma(yi = y.resam, vi = s2.resam, method = "DL")
      trimfill.resam <- pb.trimfill(rma.resam, estimator = "R0")
      stat.trimfill.resam[i] <- trimfill.resam$k0
      if(theo.pval) pval.trimfill.theo.resam[i] <- trimfill.resam$pval
      options(warn = 0)
    }
  }

  if(is.element("rank", methods)) pval.rank <- (sum(abs(stat.rank.resam) >= abs(stat.rank)) + 1)/(iter.resam + 1)
  if(is.element("reg", methods)) pval.reg <- (sum(abs(stat.reg.resam) >= abs(stat.reg)) + 1)/(iter.resam + 1)
  if(is.element("reg.het", methods)) pval.reg.het <- (sum(abs(stat.reg.het.resam) >= abs(stat.reg.het)) + 1)/(iter.resam + 1)
  if(is.element("skew", methods)) pval.skew <- (sum(abs(stat.skew.resam) >= abs(stat.skew)) + 1)/(iter.resam + 1)
  if(is.element("skew.het", methods)) pval.skew.het <- (sum(abs(stat.skew.het.resam) >= abs(stat.skew.het)) + 1)/(iter.resam + 1)
  if(is.element("inv.sqrt.n", methods)) pval.inv.sqrt.n <- (sum(abs(stat.inv.sqrt.n.resam) >= abs(stat.inv.sqrt.n)) + 1)/(iter.resam + 1)
  if(is.element("trimfill", methods)) pval.trimfill <- (sum(abs(stat.trimfill.resam) >= abs(stat.trimfill)) + 1)/(iter.resam + 1)

  if(length(methods) == 1){
    if(!theo.pval) out <- get(paste0("pval.", methods))
    if(theo.pval){
      out <- list(get(paste0("pval.", methods)), get(paste0("pval.", methods, ".theo")))
      names(out) <- c(paste0("pval.", methods), paste0("pval.", methods, ".theo"))
    }
  }

  if(length(methods) > 1){
    stat.hybrid <- min(c(pval.rank, pval.reg, pval.reg.het, pval.skew, pval.skew.het, pval.inv.sqrt.n, pval.trimfill), na.rm = TRUE)
    if(theo.pval) stat.hybrid.theo <- min(c(pval.rank.theo, pval.reg.theo, pval.reg.het.theo, pval.skew.theo, pval.skew.het.theo, pval.inv.sqrt.n.theo, pval.trimfill.theo), na.rm = TRUE)
    pval.rank.resam <- pval.reg.resam <- pval.reg.het.resam <- pval.skew.resam <- pval.skew.het.resam <-
      pval.inv.sqrt.n.resam <- pval.trimfill.resam <- rep(NA, iter.resam)
    for(i in 1:iter.resam){
      if(theo.pval) stat.hybrid.theo.resam[i] <- min(c(pval.rank.theo.resam[i], pval.reg.theo.resam[i], pval.reg.het.theo.resam[i], pval.skew.theo.resam[i], pval.skew.het.theo.resam[i], pval.inv.sqrt.n.theo.resam[i], pval.trimfill.theo.resam[i]), na.rm = TRUE)
      if(is.element("rank", methods)) pval.rank.resam[i] <- (sum(abs(stat.rank.resam[-i]) >= abs(stat.rank.resam[i])) + 1)/iter.resam
      if(is.element("reg", methods)) pval.reg.resam[i] <- (sum(abs(stat.reg.resam[-i]) >= abs(stat.reg.resam[i])) + 1)/iter.resam
      if(is.element("reg.het", methods)) pval.reg.het.resam[i] <- (sum(abs(stat.reg.het.resam[-i]) >= abs(stat.reg.het.resam[i])) + 1)/iter.resam
      if(is.element("skew", methods)) pval.skew.resam[i] <- (sum(abs(stat.skew.resam[-i]) >= abs(stat.skew.resam[i])) + 1)/iter.resam
      if(is.element("skew.het", methods)) pval.skew.het.resam[i] <- (sum(abs(stat.skew.het.resam[-i]) >= abs(stat.skew.het.resam[i])) + 1)/iter.resam
      if(is.element("inv.sqrt.n", methods)) pval.inv.sqrt.n.resam[i] <- (sum(abs(stat.inv.sqrt.n.resam[-i]) >= abs(stat.inv.sqrt.n.resam[i])) + 1)/iter.resam
      if(is.element("trimfill", methods)) pval.trimfill.resam[i] <- (sum(abs(stat.trimfill.resam[-i]) >= abs(stat.trimfill.resam[i])) + 1)/iter.resam
      stat.hybrid.resam[i] <- min(c(pval.rank.resam[i], pval.reg.resam[i], pval.reg.het.resam[i], pval.skew.resam[i], pval.skew.het.resam[i], pval.inv.sqrt.n.resam[i], pval.trimfill.resam[i]), na.rm = TRUE)
    }
    pval.hybrid <- (sum(stat.hybrid.resam <= stat.hybrid) + 1)/(iter.resam + 1)
    if(!theo.pval){
      out <- list(pval.rank = pval.rank, pval.reg = pval.reg, pval.reg.het = pval.reg.het, pval.skew = pval.skew, pval.skew.het = pval.skew.het,
        pval.inv.sqrt.n = pval.inv.sqrt.n, pval.trimfill = pval.trimfill, pval.hybrid = pval.hybrid)
    }
    if(theo.pval){
      pval.hybrid.theo <- (sum(stat.hybrid.theo.resam <= stat.hybrid.theo) + 1)/(iter.resam + 1)
      out <- list(pval.rank = pval.rank, pval.rank.theo = pval.rank.theo, pval.reg = pval.reg, pval.reg.theo = pval.reg.theo, pval.reg.het = pval.reg.het, pval.reg.het.theo = pval.reg.het.theo,
        pval.skew = pval.skew, pval.skew.theo = pval.skew.theo, pval.skew.het = pval.skew.het, pval.skew.het.theo = pval.skew.het.theo, pval.inv.sqrt.n = pval.inv.sqrt.n, pval.inv.sqrt.n.theo = pval.inv.sqrt.n.theo,
        pval.trimfill = pval.trimfill, pval.trimfill.theo = pval.trimfill.theo, pval.hybrid = pval.hybrid, pval.hybrid.theo = pval.hybrid.theo)
    }
    na.test <- which(is.na(out))
    if(length(na.test) > 0) out <- out[-na.test]
  }

  return(out)
}

##############################
pb.hybrid.binary <- function(y = NA, s2 = NA, n = NA, n00, n01, n10, n11, methods = "reg", iter.resam = 1000, theo.pval = TRUE){
  pval.rank <- pval.reg <- pval.reg.het <- pval.skew <- pval.skew.het <- pval.inv.sqrt.n <- pval.trimfill <-
    pval.n <- pval.inv.n <- pval.as.rank <- pval.as.reg <- pval.as.reg.het <-
    pval.smoothed <- pval.smoothed.het <- pval.score <- pval.count <- NA
  pval.rank.theo <- pval.reg.theo <- pval.reg.het.theo <- pval.skew.theo <- pval.skew.het.theo <- pval.inv.sqrt.n.theo <- pval.trimfill.theo <-
    pval.n.theo <- pval.inv.n.theo <- pval.as.rank.theo <- pval.as.reg.theo <- pval.as.reg.het.theo <-
    pval.smoothed.theo <- pval.smoothed.het.theo <- pval.score.theo <- pval.count.theo <- NA

  n00.ori <- n00
  n01.ori <- n01
  n10.ori <- n10
  n11.ori <- n11

  counts <- check.counts(n00, n01, n10, n11)
  n00 <- counts$n00
  n01 <- counts$n01
  n10 <- counts$n10
  n11 <- counts$n11

  y <- log(n11/n10*n00/n01)
  s2 <- 1/n00 + 1/n01 + 1/n10 + 1/n11
  n <- n00 + n01 + n10 + n11
  pi0 <- n01/(n00 + n01)
  n0Sum <- n00 + n01
  n1Sum <- n10 + n11

  if(is.element("rank", methods)){
    rank <- pb.rank(y, s2)
    stat.rank <- rank$stat
    if(theo.pval) pval.rank.theo <- rank$pval
  }
  if(is.element("reg", methods)){
    reg <- pb.reg(y, s2)
    stat.reg <- reg$stat
    if(theo.pval) pval.reg.theo <- reg$pval
  }
  if(is.element("reg.het", methods)){
    reg.het <- pb.reg.het(y, s2)
    stat.reg.het <- reg.het$stat
    if(theo.pval) pval.reg.het.theo <- reg.het$pval
  }
  if(is.element("skew", methods)){
    skew <- pb.skew(y, s2)
    stat.skew <- skew$stat
    if(theo.pval) pval.skew.theo <- skew$pval
  }
  if(is.element("skew.het", methods)){
    skew.het <- pb.skew.het(y, s2)
    stat.skew.het <- skew.het$stat
    if(theo.pval) pval.skew.het.theo <- skew.het$pval
  }
  if(is.element("inv.sqrt.n", methods)){
    inv.sqrt.n <- pb.inv.sqrt.n(y, s2, n)
    stat.inv.sqrt.n <- inv.sqrt.n$stat
    if(theo.pval) pval.inv.sqrt.n.theo <- inv.sqrt.n$pval
  }
  if(is.element("trimfill", methods)){
    options(warn = -1)
    rma <- rma(yi = y, vi = s2, method = "DL")
    trimfill <- pb.trimfill(rma, estimator = "R0")
    stat.trimfill <- trimfill$k0
    if(theo.pval) pval.trimfill.theo <- trimfill$pval
    options(warn = 0)
  }
  if(is.element("n", methods)){
    pbn <- pb.n(y = y, n00 = n00, n01 = n01, n10 = n10, n11 = n11)
    stat.n <- pbn$stat
    if(theo.pval) pval.n.theo <- pbn$pval
  }
  if(is.element("inv.n", methods)){
    inv.n <- pb.inv.n(y = y, n00 = n00, n01 = n01, n10 = n10, n11 = n11)
    stat.inv.n <- inv.n$stat
    if(theo.pval) pval.inv.n.theo <- inv.n$pval
  }
  if(is.element("as.rank", methods)){
    as.rank <- pb.as.rank(n00 = n00, n01 = n01, n10 = n10, n11 = n11)
    stat.as.rank <- as.rank$stat
    if(theo.pval) pval.as.rank.theo <- as.rank$pval
  }
  if(is.element("as.reg", methods)){
    as.reg <- pb.as.reg(n00 = n00, n01 = n01, n10 = n10, n11 = n11)
    stat.as.reg <- as.reg$stat
    if(theo.pval) pval.as.reg.theo <- as.reg$pval
  }
  if(is.element("as.reg.het", methods)){
    as.reg.het <- pb.as.reg.het(n00 = n00, n01 = n01, n10 = n10, n11 = n11)
    stat.as.reg.het <- as.reg.het$stat
    if(theo.pval) pval.as.reg.het.theo <- as.reg.het$pval
  }
  if(is.element("smoothed", methods)){
    smoothed <- pb.smoothed(y = y, n00 = n00, n01 = n01, n10 = n10, n11 = n11)
    stat.smoothed <- smoothed$stat
    if(theo.pval) pval.smoothed.theo <- smoothed$pval
  }
  if(is.element("smoothed.het", methods)){
    smoothed.het <- pb.smoothed.het(y = y, n00 = n00, n01 = n01, n10 = n10, n11 = n11)
    stat.smoothed.het <- smoothed.het$stat
    if(theo.pval) pval.smoothed.het.theo <- smoothed.het$pval
  }
  if(is.element("score", methods)){
    score <- pb.score(n00 = n00, n01 = n01, n10 = n10, n11 = n11)
    stat.score <- score$stat
    if(theo.pval) pval.score.theo <- score$pval
  }
  if(is.element("count", methods)){
    count <- pb.count(n00 = n00.ori, n01 = n01.ori, n10 = n10.ori, n11 = n11.ori)
    stat.count <- count$stat
    if(theo.pval) pval.count.theo <- count$pval
  }

  N <- length(y)
  w <- 1/s2
  theta.hat <- sum(w*y)/sum(w)
  Q <- sum(w*(y - theta.hat)^2)
  tau2.hat <- (Q - N + 1)/(sum(w) - sum(w^2)/sum(w))
  tau2.hat <- max(c(0, tau2.hat))
  w <- 1/(s2 + tau2.hat)
  theta.hat <- sum(w*y)/sum(w)
  if(all(is.na(n))) n <- rep(NA, N)

  stat.rank.resam <- stat.reg.resam <- stat.reg.het.resam <- stat.skew.resam <- stat.skew.het.resam <-
    stat.inv.sqrt.n.resam <- stat.trimfill.resam <-
    stat.n.resam <- stat.inv.n.resam <- stat.as.rank.resam <- stat.as.reg.resam <- stat.as.reg.het.resam <-
    stat.smoothed.resam <- stat.smoothed.het.resam <- stat.score.resam <- stat.count.resam <- stat.hybrid.resam <- stat.hybrid.theo.resam <- rep(NA, iter.resam)
  pval.rank.theo.resam <- pval.reg.theo.resam <- pval.reg.het.theo.resam <- pval.skew.theo.resam <- pval.skew.het.theo.resam <- pval.inv.sqrt.n.theo.resam <- pval.trimfill.theo.resam <-
    pval.n.theo.resam <- pval.inv.n.theo.resam <- pval.as.rank.theo.resam <- pval.as.reg.theo.resam <- pval.as.reg.het.theo.resam <-
    pval.smoothed.theo.resam <- pval.smoothed.het.theo.resam <- pval.score.theo.resam <- pval.count.theo.resam <- rep(NA, iter.resam)
  for(i in 1:iter.resam){
    idx <- sample(1:N, replace = TRUE)
    n0Sum.resam <- n0Sum[idx]
    n1Sum.resam <- n1Sum[idx]
    pi0.resam <- pi0[idx]
    s2.resam <- s2[idx]
    theta.resam <- rnorm(n = N, mean = theta.hat, sd = sqrt(s2.resam + tau2.hat))
    n00.resam <- n01.resam <- n10.resam <- n11.resam <- rep(NA, N)
    for(j in 1:N){
      counts.resam <- find.counts(n0. = n0Sum.resam[j], n1. = n1Sum.resam[j], lor = theta.resam[j], lor.var = s2.resam[j], p0.ori = pi0.resam[j])
      n00.resam[j] <- counts.resam$n00
      n01.resam[j] <- counts.resam$n01
      n10.resam[j] <- counts.resam$n10
      n11.resam[j] <- counts.resam$n11
    }
    n00.ori.resam <- n00.resam
    n00.ori.resam <- round(n00.ori.resam)
    n01.ori.resam <- n01.resam
    n01.ori.resam <- round(n01.ori.resam)
    n10.ori.resam <- n10.resam
    n10.ori.resam <- round(n10.ori.resam)
    n11.ori.resam <- n11.resam
    n11.ori.resam <- round(n11.ori.resam)
    counts.resam <- check.counts(n00.resam, n01.resam, n10.resam, n11.resam)
    n00.resam <- counts.resam$n00
    n01.resam <- counts.resam$n01
    n10.resam <- counts.resam$n10
    n11.resam <- counts.resam$n11
    y.resam <- log(n11.resam/n10.resam*n00.resam/n01.resam)
    s2.resam <- 1/n00.resam + 1/n01.resam + 1/n10.resam + 1/n11.resam
    n.resam <- n00.resam + n01.resam + n10.resam + n11.resam

    if(is.element("rank", methods)){
      rank.resam <- pb.rank(y.resam, s2.resam)
      stat.rank.resam[i] <- rank.resam$stat
      if(theo.pval) pval.rank.theo.resam[i] <- rank.resam$pval
    }
    if(is.element("reg", methods)){
      reg.resam <- pb.reg(y.resam, s2.resam)
      stat.reg.resam[i] <- reg.resam$stat
      if(theo.pval) pval.reg.theo.resam[i] <- reg.resam$pval
    }
    if(is.element("reg.het", methods)){
      reg.het.resam <- pb.reg.het(y.resam, s2.resam)
      stat.reg.het.resam[i] <- reg.het.resam$stat
      if(theo.pval) pval.reg.het.theo.resam[i] <- reg.het.resam$pval
    }
    if(is.element("skew", methods)){
      skew.resam <- pb.skew(y.resam, s2.resam)
      stat.skew.resam[i] <- skew.resam$stat
      if(theo.pval) pval.skew.theo.resam[i] <- skew.resam$pval
    }
    if(is.element("skew.het", methods)){
      skew.het.resam <- pb.skew.het(y.resam, s2.resam)
      stat.skew.het.resam[i] <- skew.het.resam$stat
      if(theo.pval) pval.skew.het.theo.resam[i] <- skew.het.resam$pval
    }
    if(is.element("inv.sqrt.n", methods)){
      inv.sqrt.n.resam <- pb.inv.sqrt.n(y.resam, s2.resam, n.resam)
      stat.inv.sqrt.n.resam[i] <- inv.sqrt.n.resam$stat
      if(theo.pval) pval.inv.sqrt.n.theo.resam[i] <- inv.sqrt.n.resam$pval
    }
    if(is.element("trimfill", methods)){
      options(warn = -1)
      rma.resam <- rma(yi = y.resam, vi = s2.resam, method = "DL")
      trimfill.resam <- pb.trimfill(rma.resam, estimator = "R0")
      stat.trimfill.resam[i] <- trimfill.resam$k0
      if(theo.pval) pval.trimfill.theo.resam[i] <- trimfill.resam$pval
      options(warn = 0)
    }
    if(is.element("n", methods)){
      pbn.resam <- pb.n(y = y.resam, n00 = n00.resam, n01 = n01.resam, n10 = n10.resam, n11 = n11.resam)
      stat.n.resam[i] <- pbn.resam$stat
      if(theo.pval) pval.n.theo.resam[i] <- pbn.resam$pval
    }
    if(is.element("inv.n", methods)){
      inv.n.resam <- pb.inv.n(y = y.resam, n00 = n00.resam, n01 = n01.resam, n10 = n10.resam, n11 = n11.resam)
      stat.inv.n.resam[i] <- inv.n.resam$stat
      if(theo.pval) pval.inv.n.theo.resam[i] <- inv.n.resam$pval
    }
    if(is.element("as.rank", methods)){
      as.rank.resam <- pb.as.rank(n00 = n00.resam, n01 = n01.resam, n10 = n10.resam, n11 = n11.resam)
      stat.as.rank.resam[i] <- as.rank.resam$stat
      if(theo.pval) pval.as.rank.theo.resam[i] <- as.rank.resam$pval
    }
    if(is.element("as.reg", methods)){
      as.reg.resam <- pb.as.reg(n00 = n00.resam, n01 = n01.resam, n10 = n10.resam, n11 = n11.resam)
      stat.as.reg.resam[i] <- as.reg.resam$stat
      if(theo.pval) pval.as.reg.theo.resam[i] <- as.reg.resam$pval
    }
    if(is.element("as.reg.het", methods)){
      as.reg.het.resam <- pb.as.reg.het(n00 = n00.resam, n01 = n01.resam, n10 = n10.resam, n11 = n11.resam)
      stat.as.reg.het.resam[i] <- as.reg.het.resam$stat
      if(theo.pval) pval.as.reg.het.theo.resam[i] <- as.reg.het.resam$pval
    }
    if(is.element("smoothed", methods)){
      smoothed.resam <- pb.smoothed(y = y.resam, n00 = n00.resam, n01 = n01.resam, n10 = n10.resam, n11 = n11.resam)
      stat.smoothed.resam[i] <- smoothed.resam$stat
      if(theo.pval) pval.smoothed.theo.resam[i] <- smoothed.resam$pval
    }
    if(is.element("smoothed.het", methods)){
      smoothed.het.resam <- pb.smoothed.het(y = y.resam, n00 = n00.resam, n01 = n01.resam, n10 = n10.resam, n11 = n11.resam)
      stat.smoothed.het.resam[i] <- smoothed.het.resam$stat
      if(theo.pval) pval.smoothed.het.theo.resam[i] <- smoothed.het.resam$pval
    }
    if(is.element("score", methods)){
      score.resam <- pb.score(n00 = n00.resam, n01 = n01.resam, n10 = n10.resam, n11 = n11.resam)
      stat.score.resam[i] <- score.resam$stat
      if(theo.pval) pval.score.theo.resam[i] <- score.resam$pval
    }
    if(is.element("count", methods)){
      count.resam <- pb.count(n00 = n00.ori.resam, n01 = n01.ori.resam, n10 = n10.ori.resam, n11 = n11.ori.resam)
      stat.count.resam[i] <- count.resam$stat
      if(theo.pval) pval.count.theo.resam[i] <- count.resam$pval
    }
  }

  if(is.element("rank", methods)) pval.rank <- (sum(abs(stat.rank.resam) >= abs(stat.rank)) + 1)/(iter.resam + 1)
  if(is.element("reg", methods)) pval.reg <- (sum(abs(stat.reg.resam) >= abs(stat.reg)) + 1)/(iter.resam + 1)
  if(is.element("reg.het", methods)) pval.reg.het <- (sum(abs(stat.reg.het.resam) >= abs(stat.reg.het)) + 1)/(iter.resam + 1)
  if(is.element("skew", methods)) pval.skew <- (sum(abs(stat.skew.resam) >= abs(stat.skew)) + 1)/(iter.resam + 1)
  if(is.element("skew.het", methods)) pval.skew.het <- (sum(abs(stat.skew.het.resam) >= abs(stat.skew.het)) + 1)/(iter.resam + 1)
  if(is.element("inv.sqrt.n", methods)) pval.inv.sqrt.n <- (sum(abs(stat.inv.sqrt.n.resam) >= abs(stat.inv.sqrt.n)) + 1)/(iter.resam + 1)
  if(is.element("trimfill", methods)) pval.trimfill <- (sum(abs(stat.trimfill.resam) >= abs(stat.trimfill)) + 1)/(iter.resam + 1)
  if(is.element("n", methods)) pval.n <- (sum(abs(stat.n.resam) >= abs(stat.n)) + 1)/(iter.resam + 1)
  if(is.element("inv.n", methods)) pval.inv.n <- (sum(abs(stat.inv.n.resam) >= abs(stat.inv.n)) + 1)/(iter.resam + 1)
  if(is.element("as.rank", methods)) pval.as.rank <- (sum(abs(stat.as.rank.resam) >= abs(stat.as.rank)) + 1)/(iter.resam + 1)
  if(is.element("as.reg", methods)) pval.as.reg <- (sum(abs(stat.as.reg.resam) >= abs(stat.as.reg)) + 1)/(iter.resam + 1)
  if(is.element("as.reg.het", methods)) pval.as.reg.het <- (sum(abs(stat.as.reg.het.resam) >= abs(stat.as.reg.het)) + 1)/(iter.resam + 1)
  if(is.element("smoothed", methods)) pval.smoothed <- (sum(abs(stat.smoothed.resam) >= abs(stat.smoothed)) + 1)/(iter.resam + 1)
  if(is.element("smoothed.het", methods)) pval.smoothed.het <- (sum(abs(stat.smoothed.het.resam) >= abs(stat.smoothed.het)) + 1)/(iter.resam + 1)
  if(is.element("score", methods)) pval.score <- (sum(abs(stat.score.resam) >= abs(stat.score)) + 1)/(iter.resam + 1)
  if(is.element("count", methods)) pval.count <- (sum(abs(stat.count.resam) >= abs(stat.count)) + 1)/(iter.resam + 1)

  if(length(methods) == 1){
    if(!theo.pval) out <- get(paste0("pval.", methods))
    if(theo.pval){
      out <- list(get(paste0("pval.", methods)), get(paste0("pval.", methods, ".theo")))
      names(out) <- c(paste0("pval.", methods), paste0("pval.", methods, ".theo"))
    }
  }

  if(length(methods) > 1){
    stat.hybrid <- min(c(pval.rank, pval.reg, pval.reg.het, pval.skew, pval.skew.het, pval.inv.sqrt.n, pval.trimfill,
      pval.n, pval.inv.n, pval.as.rank, pval.as.reg, pval.as.reg.het, pval.smoothed, pval.smoothed.het, pval.score, pval.count), na.rm = TRUE)
    if(theo.pval) stat.hybrid.theo <- min(c(pval.rank.theo, pval.reg.theo, pval.reg.het.theo, pval.skew.theo, pval.skew.het.theo, pval.inv.sqrt.n.theo, pval.trimfill.theo,
      pval.n.theo, pval.inv.n.theo, pval.as.rank.theo, pval.as.reg.theo, pval.as.reg.het.theo, pval.smoothed.theo, pval.smoothed.het.theo, pval.score.theo, pval.count.theo), na.rm = TRUE)
    pval.rank.resam <- pval.reg.resam <- pval.reg.het.resam <- pval.skew.resam <- pval.skew.het.resam <-
      pval.inv.sqrt.n.resam <- pval.trimfill.resam <-
      pval.n.resam <- pval.inv.n.resam <- pval.as.rank.resam <- pval.as.reg.resam <- pval.as.reg.het.resam <-
      pval.smoothed.resam <- pval.smoothed.het.resam <- pval.score.resam <- pval.count.resam <- rep(NA, iter.resam)
    for(i in 1:iter.resam){
      if(theo.pval) stat.hybrid.theo.resam[i] <- min(c(pval.rank.theo.resam[i], pval.reg.theo.resam[i], pval.reg.het.theo.resam[i], pval.skew.theo.resam[i], pval.skew.het.theo.resam[i], pval.inv.sqrt.n.theo.resam[i], pval.trimfill.theo.resam[i],
        pval.n.theo.resam[i], pval.inv.n.theo.resam[i], pval.as.rank.theo.resam[i], pval.as.reg.theo.resam[i], pval.as.reg.het.theo.resam[i], pval.smoothed.theo.resam[i], pval.smoothed.het.theo.resam[i], pval.score.theo.resam[i], pval.count.theo.resam[i]), na.rm = TRUE)
      if(is.element("rank", methods)) pval.rank.resam[i] <- (sum(abs(stat.rank.resam[-i]) >= abs(stat.rank.resam[i])) + 1)/iter.resam
      if(is.element("reg", methods)) pval.reg.resam[i] <- (sum(abs(stat.reg.resam[-i]) >= abs(stat.reg.resam[i])) + 1)/iter.resam
      if(is.element("reg.het", methods)) pval.reg.het.resam[i] <- (sum(abs(stat.reg.het.resam[-i]) >= abs(stat.reg.het.resam[i])) + 1)/iter.resam
      if(is.element("skew", methods)) pval.skew.resam[i] <- (sum(abs(stat.skew.resam[-i]) >= abs(stat.skew.resam[i])) + 1)/iter.resam
      if(is.element("skew.het", methods)) pval.skew.het.resam[i] <- (sum(abs(stat.skew.het.resam[-i]) >= abs(stat.skew.het.resam[i])) + 1)/iter.resam
      if(is.element("inv.sqrt.n", methods)) pval.inv.sqrt.n.resam[i] <- (sum(abs(stat.inv.sqrt.n.resam[-i]) >= abs(stat.inv.sqrt.n.resam[i])) + 1)/iter.resam
      if(is.element("trimfill", methods)) pval.trimfill.resam[i] <- (sum(abs(stat.trimfill.resam[-i]) >= abs(stat.trimfill.resam[i])) + 1)/iter.resam
      if(is.element("n", methods)) pval.n.resam[i] <- (sum(abs(stat.n.resam[-i]) >= abs(stat.n.resam[i])) + 1)/iter.resam
      if(is.element("inv.n", methods)) pval.inv.n.resam[i] <- (sum(abs(stat.inv.n.resam[-i]) >= abs(stat.inv.n.resam[i])) + 1)/iter.resam
      if(is.element("as.rank", methods)) pval.as.rank.resam[i] <- (sum(abs(stat.as.rank.resam[-i]) >= abs(stat.as.rank.resam[i])) + 1)/iter.resam
      if(is.element("as.reg", methods)) pval.as.reg.resam[i] <- (sum(abs(stat.as.reg.resam[-i]) >= abs(stat.as.reg.resam[i])) + 1)/iter.resam
      if(is.element("as.reg.het", methods)) pval.as.reg.het.resam[i] <- (sum(abs(stat.as.reg.het.resam[-i]) >= abs(stat.as.reg.het.resam[i])) + 1)/iter.resam
      if(is.element("smoothed", methods)) pval.smoothed.resam[i] <- (sum(abs(stat.smoothed.resam[-i]) >= abs(stat.smoothed.resam[i])) + 1)/iter.resam
      if(is.element("smoothed.het", methods)) pval.smoothed.het.resam[i] <- (sum(abs(stat.smoothed.het.resam[-i]) >= abs(stat.smoothed.het.resam[i])) + 1)/iter.resam
      if(is.element("score", methods)) pval.score.resam[i] <- (sum(abs(stat.score.resam[-i]) >= abs(stat.score.resam[i])) + 1)/iter.resam
      if(is.element("count", methods)) pval.count.resam[i] <- (sum(abs(stat.count.resam[-i]) >= abs(stat.count.resam[i])) + 1)/iter.resam
      stat.hybrid.resam[i] <- min(c(pval.rank.resam[i], pval.reg.resam[i], pval.reg.het.resam[i], pval.skew.resam[i], pval.skew.het.resam[i], pval.inv.sqrt.n.resam[i], pval.trimfill.resam[i],
        pval.n.resam[i], pval.inv.n.resam[i], pval.as.rank.resam[i], pval.as.reg.resam[i], pval.as.reg.het.resam[i], pval.smoothed.resam[i], pval.smoothed.het.resam[i], pval.score.resam[i], pval.count.resam[i]), na.rm = TRUE)
    }
    pval.hybrid <- (sum(stat.hybrid.resam <= stat.hybrid) + 1)/(iter.resam + 1)
    if(!theo.pval){
      out <- list(pval.rank = pval.rank, pval.reg = pval.reg, pval.reg.het = pval.reg.het, pval.skew = pval.skew, pval.skew.het = pval.skew.het,
        pval.inv.sqrt.n = pval.inv.sqrt.n, pval.trimfill = pval.trimfill,
        pval.n = pval.n, pval.inv.n = pval.inv.n, pval.as.rank = pval.as.rank, pval.as.reg = pval.as.reg, pval.as.reg.het = pval.as.reg.het,
        pval.smoothed = pval.smoothed, pval.smoothed.het = pval.smoothed.het, pval.score = pval.score, pval.count = pval.count,
        pval.hybrid = pval.hybrid)
    }
    if(theo.pval){
      pval.hybrid.theo <- (sum(stat.hybrid.theo.resam <= stat.hybrid.theo) + 1)/(iter.resam + 1)
      out <- list(pval.rank = pval.rank, pval.rank.theo = pval.rank.theo, pval.reg = pval.reg, pval.reg.theo = pval.reg.theo, pval.reg.het = pval.reg.het, pval.reg.het.theo = pval.reg.het.theo, pval.skew = pval.skew, pval.skew.theo = pval.skew.theo, pval.skew.het = pval.skew.het, pval.skew.het.theo = pval.skew.het.theo,
        pval.inv.sqrt.n = pval.inv.sqrt.n, pval.inv.sqrt.n.theo = pval.inv.sqrt.n.theo, pval.trimfill = pval.trimfill, pval.trimfill.theo = pval.trimfill.theo,
        pval.n = pval.n, pval.n.theo = pval.n.theo, pval.inv.n = pval.inv.n, pval.inv.n.theo = pval.inv.n.theo, pval.as.rank = pval.as.rank, pval.as.rank.theo = pval.as.rank.theo, pval.as.reg = pval.as.reg, pval.as.reg.theo = pval.as.reg.theo, pval.as.reg.het = pval.as.reg.het, pval.as.reg.het.theo = pval.as.reg.het.theo,
        pval.smoothed = pval.smoothed, pval.smoothed.theo = pval.smoothed.theo, pval.smoothed.het = pval.smoothed.het, pval.smoothed.het.theo = pval.smoothed.het.theo, pval.score = pval.score, pval.score.theo = pval.score.theo, pval.count = pval.count, pval.count.theo = pval.count.theo,
        pval.hybrid = pval.hybrid, pval.hybrid.theo = pval.hybrid.theo)
    }
    na.test <- which(is.na(out))
    if(length(na.test) > 0) out <- out[-na.test]
  }

  return(out)
}

##############################
pb.rank <- function(y, s2){
  theta.hat <- sum(y/s2)/sum(1/s2)
  s2.star <- s2 - 1/sum(1/s2)
  y.star <- (y - theta.hat)/sqrt(s2.star)
  if(all(abs(diff(y.star[!is.na(y.star)])) < 1e-5) | all(abs(diff(s2.star[!is.na(s2.star)])) < 1e-5)){
    out <- list(pval = 1, stat = 0)
  }else{
    out <- cor.test(x = y.star, y = s2, alternative = "two.sided", method = "kendall", exact = FALSE)
    out <- list(pval = out$p.value, stat = as.numeric(out$statistic))
  }
  return(out)
}

##############################
pb.reg <- function(y, s2, n = NA, n00 = NA, n01 = NA, n10 = NA, n11 = NA){
  x.reg <- sqrt(s2)
  y.reg <- y
  if(all(abs(diff(x.reg[!is.na(x.reg)])) < 1e-5) | all(abs(diff(y.reg[!is.na(y.reg)])) < 1e-5)){
    out <- list(pval = 1, stat = 0, coef = c(0, 0), std.res = y.reg/sqrt(s2))
  }else{
    w.reg <- 1/s2
    X <- cbind(1, x.reg)
    Y <- as.matrix(y.reg)
    W <- diag(w.reg)
    XWX <- t(X) %*% W %*% X
    if(as.numeric(rankMatrix(XWX)) < dim(XWX)[1]){
      out <- list(pval = 1, stat = 0, coef = c(0, 0), std.res = y.reg/sqrt(s2))
    }else{
      inv <- solve(XWX)
      coef <- inv %*% t(X) %*% W %*% Y
      var.coef <- inv
      pval <- as.numeric(2*pnorm(-abs(coef[2, 1])/sqrt(var.coef[2, 2])))
      res <- Y - X %*% coef
      std.res <- res/sqrt(s2)
      out <- list(pval = pval, stat = as.numeric(coef[2, 1]/sqrt(var.coef[2, 2])), coef = as.numeric(coef), std.res = std.res)
    }
  }
  return(out)
}

##############################
pb.reg.het <- function(y, s2, n = NA, n00 = NA, n01 = NA, n10 = NA, n11 = NA){
  k <- length(y)
  coef <- pb.reg(y, s2)$coef
  x.reg <- sqrt(s2)
  y.reg <- y
  w <- 1/s2
  Q <- sum(w*(y.reg - coef[1] - coef[2]*x.reg)^2)
  if(abs(sum(w)*sum(w*x.reg^2) - (sum(w*x.reg))^2) < 1e-5){
    F <- sum(w) - (sum(w^2)*sum(w*x.reg^2) - 2*sum(w^2*x.reg)*sum(w*x.reg) + sum(w)*sum(w^2*x.reg^2))*1e5
  }else{
    F <- sum(w) - (sum(w^2)*sum(w*x.reg^2) - 2*sum(w^2*x.reg)*sum(w*x.reg) + sum(w)*sum(w^2*x.reg^2))/(sum(w)*sum(w*x.reg^2) - (sum(w*x.reg))^2)
  }
  tau2.hat <- (Q - (k - 2))/F
  tau2.hat <- max(c(0, tau2.hat))

  x.reg <- sqrt(s2)
  y.reg <- y
  if(all(abs(diff(x.reg[!is.na(x.reg)])) < 1e-5) | all(abs(diff(y.reg[!is.na(y.reg)])) < 1e-5)){
    out <- list(pval = 1, stat = 0, coef = c(0, 0), std.res = y.reg/sqrt(s2 + tau2.hat))
  }else{
    w.reg <- 1/(s2 + tau2.hat)
    X <- cbind(1, x.reg)
    Y <- as.matrix(y.reg)
    W <- diag(w.reg)
    XWX <- t(X) %*% W %*% X
    if(as.numeric(rankMatrix(XWX)) < dim(XWX)[1]){
      out <- list(pval = 1, stat = 0, coef = c(0, 0), std.res = y.reg/sqrt(s2 + tau2.hat))
    }else{
      inv <- solve(XWX)
      coef <- inv %*% t(X) %*% W %*% Y
      var.coef <- inv
      pval <- as.numeric(2*pnorm(-abs(coef[2, 1])/sqrt(var.coef[2, 2])))
      res <- Y - X %*% coef
      std.res <- res/sqrt(s2 + tau2.hat)
      out <- list(pval = pval, stat = as.numeric(coef[2, 1]/sqrt(var.coef[2, 2])), coef = as.numeric(coef), std.res = std.res, tau2.hat = tau2.hat)
    }
  }
  return(out)
}

##############################
pb.skew <- function(y, s2, n = NA, n00 = NA, n01 = NA, n10 = NA, n11 = NA){
  std.res <- pb.reg(y, s2)$std.res
  cm2 <- var(std.res)
  cm3 <- mean((std.res - mean(std.res))^3)
  skewness <- cm3/(cm2^(1.5))
  pval <- 2*pnorm(-sqrt(length(y)/6)*abs(skewness))
  out <- list(pval = as.numeric(pval), stat = as.numeric(skewness))
  return(out)
}

##############################
pb.skew.het <- function(y, s2, n = NA, n00 = NA, n01 = NA, n10 = NA, n11 = NA){
  std.res <- pb.reg.het(y, s2)$std.res
  cm2 <- var(std.res)
  cm3 <- mean((std.res - mean(std.res))^3)
  skewness <- cm3/(cm2^(1.5))
  pval <- 2*pnorm(-sqrt(length(y)/6)*abs(skewness))
  out <- list(pval = as.numeric(pval), stat = as.numeric(skewness))
  return(out)
}

##############################
pb.inv.sqrt.n <- function(y, s2 = NA, n, n00 = NA, n01 = NA, n10 = NA, n11 = NA){
  x.reg <- 1/sqrt(n)
  y.reg <- y
  w.reg <- n
  if(all(abs(diff(x.reg[!is.na(x.reg)])) < 1e-5) | all(abs(diff(y.reg[!is.na(y.reg)])) < 1e-5)){
    out <- list(pval = 1, stat = 0, coef = c(0, 0))
  }else{
    out <- lm(y.reg ~ x.reg, weights = w.reg)
    out <- summary(out)$coefficients
    pval <- out["x.reg", "Pr(>|t|)"]
    coef <- as.numeric(out[,1])
    out <- list(pval = pval, stat = as.numeric(out["x.reg", "t value"]), coef = coef)
  }
  return(out)
}

##############################
pb.n <- function(y, s2 = NA, n = NA, n00, n01, n10, n11){
  n <- n00 + n01 + n10 + n11
  nSum0 <- n00 + n10
  nSum1 <- n01 + n11
  x.reg <- n
  y.reg <- y
  w.reg <- nSum0*nSum1/n
  if(all(abs(diff(x.reg[!is.na(x.reg)])) < 1e-5) | all(abs(diff(y.reg[!is.na(y.reg)])) < 1e-5)){
    out <- list(pval = 1, stat = 0, coef = c(0, 0))
  }else{
    out <- lm(y.reg ~ x.reg, weights = w.reg)
    out <- summary(out)$coefficients
    pval <- out["x.reg", "Pr(>|t|)"]
    coef <- as.numeric(out[,1])
    out <- list(pval = pval, stat = as.numeric(out["x.reg", "t value"]), coef = coef)
  }
  return(out)
}

##############################
pb.inv.n <- function(y, s2 = NA, n = NA, n00, n01, n10, n11){
  n <- n00 + n01 + n10 + n11
  nSum0 <- n00 + n10
  nSum1 <- n01 + n11
  x.reg <- 1/n
  y.reg <- y
  w.reg <- nSum0*nSum1/n
  if(all(abs(diff(x.reg[!is.na(x.reg)])) < 1e-5) | all(abs(diff(y.reg[!is.na(y.reg)])) < 1e-5)){
    out <- list(pval = 1, stat = 0, coef = c(0, 0))
  }else{
    out <- lm(y.reg ~ x.reg, weights = w.reg)
    out <- summary(out)$coefficients
    pval <- out["x.reg", "Pr(>|t|)"]
    coef <- as.numeric(out[,1])
    out <- list(pval = pval, stat = as.numeric(out["x.reg", "t value"]), coef = coef)
  }
  return(out)
}

##############################
pb.as.rank <- function(y = NA, s2 = NA, n = NA, n00, n01, n10, n11){
  delta <- asin(sqrt(n11/(n10 + n11))) - asin(sqrt(n01/(n00 + n01)))
  gamma <- 1/(4*(n10 + n11)) + 1/(4*(n00 + n01))
  out <- pb.rank(y = delta, s2 = gamma)
  return(out)
}

##############################
pb.as.reg <- function(y = NA, s2 = NA, n = NA, n00, n01, n10, n11){
  delta <- asin(sqrt(n11/(n10 + n11))) - asin(sqrt(n01/(n00 + n01)))
  gamma <- 1/(4*(n10 + n11)) + 1/(4*(n00 + n01))
  out <- pb.reg(y = delta, s2 = gamma)
  return(out)
}

##############################
pb.as.reg.het <- function(y = NA, s2 = NA, n = NA, n00, n01, n10, n11){
  delta <- asin(sqrt(n11/(n10 + n11))) - asin(sqrt(n01/(n00 + n01)))
  gamma <- 1/(4*(n10 + n11)) + 1/(4*(n00 + n01))
  out <- pb.reg.het(y = delta, s2 = gamma)
  return(out)
}

##############################
pb.smoothed <- function(y, s2 = NA, n = NA, n00, n01, n10, n11){
  p01 <- mean(n01/(n00 + n01))
  p00 <- 1 - p01
  p11 <- mean(n11/(n10 + n11))
  p10 <- 1 - p11
  s2.smoothed <- 1/((n00 + n01)*p00) + 1/((n00 + n01)*p01) + 1/((n10 + n11)*p10) + 1/((n10 + n11)*p11)
  out <- pb.reg(y = y, s2 = s2.smoothed)
  return(out)
}

##############################
pb.smoothed.het <- function(y, s2 = NA, n = NA, n00, n01, n10, n11){
  p01 <- mean(n01/(n00 + n01))
  p00 <- 1 - p01
  p11 <- mean(n11/(n10 + n11))
  p10 <- 1 - p11
  s2.smoothed <- 1/((n00 + n01)*p00) + 1/((n00 + n01)*p01) + 1/((n10 + n11)*p10) + 1/((n10 + n11)*p11)
  out <- pb.reg.het(y = y, s2 = s2.smoothed)
  return(out)
}

##############################
pb.score <- function(y = NA, s2 = NA, n = NA, n00, n01, n10, n11){
  n <- n00 + n01 + n10 + n11
  nSum0 <- n00 + n10
  nSum1 <- n01 + n11
  n0Sum <- n00 + n01
  n1Sum <- n10 + n11
  Z <- n11 - nSum1/n*n1Sum
  V <- n0Sum/n*n1Sum/n*nSum0/(n - 1)*nSum1
  y.reg <- Z/V
  x.reg <- 1/sqrt(V)
  w.reg <- V
  if(all(abs(diff(x.reg[!is.na(x.reg)])) < 1e-5) | all(abs(diff(y.reg[!is.na(y.reg)])) < 1e-5)){
    out <- list(pval = 1, stat = 0, coef = c(0, 0))
  }else{
    out <- lm(y.reg ~ x.reg, weights = w.reg)
    out <- summary(out)$coefficients
    pval <- out["x.reg", "Pr(>|t|)"]
    coef <- as.numeric(out[,1])
    out <- list(pval = pval, stat = as.numeric(out["x.reg", "t value"]), coef = coef)
  }
  return(out)
}

##############################
pb.count <- function(y = NA, s2 = NA, n = NA, n00, n01, n10, n11){
  n <- n00 + n01 + n10 + n11
  n1Sum <- n10 + n11
  nSum1 <- n01 + n11
  or.mh <- sum(n00/n*n11)/sum(n01/n*n10)
  N <- length(n00)
  n11.e <- n11.v <- rep(NA, N)
  for(i in 1:N){
    obj <- hypergeometric(n1Sum[i], nSum1[i], n[i], or.mh)
    n11.e[i] <- obj$mean()
    n11.v[i] <- obj$var()
  }
  xx <- (n11 - n11.e)/sqrt(n11.v)
  yy <- 1/n11.v
  if(all(abs(diff(xx[!is.na(xx)])) < 1e-5) | all(abs(diff(yy[!is.na(yy)])) < 1e-5)){
    out <- list(pval = 1, stat = 0)
  }else{
    out <- cor.test(x = xx, y = yy, alternative = "two.sided", method = "kendall", exact = FALSE)
    out <- list(pval = out$p.value, stat = as.numeric(out$statistic))
  }
  return(out)
}

##############################
hypergeometric <- function(n1, m1, N, psi) { ## from the package "meta"
  n2 <- N - n1
  
  if(n1<0 | n2<0 | m1<0 | m1 > N | psi <= 0)
    stop("wrong argument in hypergeometric")
  
  mode.compute <- function() {
    a <- psi - 1
    b <- -((m1 + n1 + 2) * psi + n2 - m1)     
    c <- psi * (n1 + 1) * (m1 + 1)
    q <- b + sign(b) * sqrt(b * b - 4 * a * c)
    q <- -q / 2
    
    mode <- trunc(c / q) 
    if(uu >= mode && mode >= ll) return(mode)
    else return(trunc(q / a))      
  }       
  
  r.function <- function(i) (n1 - i + 1) * (m1 - i + 1) / i / (n2 - m1 + i) * psi
  
  mean <- function() sum(prob[(ll:uu) + shift] * (ll:uu)) 
  var <-  function() sum(prob[(ll:uu) + shift] * (ll:uu)^2) - mean()^2          
  
  d <- function(x) return(prob[x + shift])
  
  p <- function(x, lower.tail = TRUE) {   
    if(lower.tail) return(sum(prob[ll:(x + shift)]))
    else return(sum(prob[(x + shift):uu]))
  }
  
  sample.low.to.high <- function(lower.end, ran) { 
    for(i in lower.end:uu) {                                
      if(ran <= prob[i + shift]) return(i)
      ran <- ran - prob[i + shift]
    }                                
  }
  
  sample.high.to.low <- function(upper.end, ran) {           
    for(i in upper.end:ll) {                              
      if(ran <= prob[i + shift]) return(i)
      ran <- ran - prob[i + shift]
    } 
  }  

  r <- function() {
    ran <- runif(1) 
    
    if(mode == ll) return(sample.low.to.high(ll, ran))            
    if(mode == uu) return(sample.high.to.low(uu, ran))                                         
    
    if(ran < prob[mode + shift]) return(mode)             
    ran <- ran - prob[mode + shift]
    
    lower <- mode - 1                                                                            
    upper <- mode + 1
    
    repeat{                                     
      if(prob[upper + shift] >= prob[lower + shift]) {              
        if(ran < prob[upper + shift]) return(upper)
        ran <- ran - prob[upper + shift]
        if(upper == uu) return(sample.high.to.low(lower, ran))
        upper <- upper + 1                            
      }
      
      else {
        if(ran < prob[lower + shift]) return(lower)
        ran <- ran - prob[lower + shift]
        if(lower == ll) return(sample.low.to.high(upper, ran))
        lower <- lower - 1                   
      }      
    } 
  }

  ll <- max(0, m1 - n2)
  uu <- min(n1, m1)              
  mode <- mode.compute()  
  
  prob <- array(1, uu - ll + 1)
  
  shift <- 1 - ll 
  if(mode < uu) #note the shift of location
    {  
      r1 <- r.function((mode + 1):uu)       
      prob[(mode + 1 + shift):(uu + shift)] <- cumprod(r1)       
    }
  
  if(mode > ll) {
    r1 <- 1 / r.function(mode:(ll + 1))
    prob[(mode - 1 + shift):(ll + shift)] <- cumprod(r1)
  }
  
  prob <- prob / sum(prob) 
  
  return(list(mean = mean, var = var, d = d, p = p, r = r))
}

##############################
## adapted from the package "metafor"
pb.trimfill <- function (x, side, estimator = "L0", maxiter = 100, verbose = FALSE, ...){
  if (!is.element("rma.uni", class(x))) 
    stop("Argument 'x' must be an object of class \"rma.uni\".")
  if (!x$int.only) 
    stop("Trim-and-fill method only applicable for models without moderators.")
  if (missing(side)) 
    side <- NULL
  estimator <- match.arg(estimator, c("L0", "R0", "Q0"))
  if (x$k == 1) 
    stop("Stopped because k = 1.")
  yi <- x$yi
  vi <- x$vi
  weights <- x$weights
  ni <- x$ni
  if (is.null(side)) {
    res <- rma(yi, vi, weights = weights, mods = sqrt(vi), 
      intercept = TRUE, method = x$method, weighted = x$weighted, ...)
    if (is.na(res$b[2])) res$b[2] <- 0
    if (res$b[2] < 0) {
      side <- "right"
    }
    else {
      side <- "left"
    }
  }
  else {
    side <- match.arg(side, c("left", "right"))
  }
  if (side == "right") {
    yi <- -1 * yi
  }
  idix <- sort(yi, index.return = TRUE)$ix
  yi <- yi[idix]
  vi <- vi[idix]
  weights <- weights[idix]
  ni <- ni[idix]
  k <- length(yi)
  k0.sav <- -1
  k0 <- 0
  iter <- 0
  while (abs(k0 - k0.sav) > 0 & iter <= maxiter) {
    k0.sav <- k0
    iter <- iter + 1
#   if (iter > maxiter) 
#     warning("Trim and fill algorithm did not converge.")
    yi.t <- yi[1:(k - k0)]
    vi.t <- vi[1:(k - k0)]
    weights.t <- weights[1:(k - k0)]
    res <- rma(yi.t, vi.t, weights = weights.t, intercept = TRUE, 
      method = x$method, weighted = x$weighted, ...)
    b <- c(res$b)
    yi.c <- yi - b
    yi.c.r <- rank(abs(yi.c), ties.method = "first")
    yi.c.r.s <- sign(yi.c) * yi.c.r
    if (estimator == "R0") {
      k0 <- (k - max(-1 * yi.c.r.s[yi.c.r.s < 0])) - 1
      se.k0 <- sqrt(2 * max(0, k0) + 2)
    }
    if (estimator == "L0") {
      Sr <- sum(yi.c.r.s[yi.c.r.s > 0])
      k0 <- (4 * Sr - k * (k + 1))/(2 * k - 1)
      varSr <- 1/24 * (k * (k + 1) * (2 * k + 1) + 10 * 
        k0^3 + 27 * k0^2 + 17 * k0 - 18 * k * k0^2 - 
        18 * k * k0 + 6 * k^2 * k0)
      se.k0 <- 4 * sqrt(varSr)/(2 * k - 1)
    }
    if (estimator == "Q0") {
      Sr <- sum(yi.c.r.s[yi.c.r.s > 0])
      k0 <- k - 1/2 - sqrt(2 * k^2 - 4 * Sr + 1/4)
      varSr <- 1/24 * (k * (k + 1) * (2 * k + 1) + 10 * 
        k0^3 + 27 * k0^2 + 17 * k0 - 18 * k * k0^2 - 
        18 * k * k0 + 6 * k^2 * k0)
      se.k0 <- 2 * sqrt(varSr)/sqrt((k - 1/2)^2 - k0 * 
        (2 * k - k0 - 1))
    }
    k0 <- max(0, k0)
    k0 <- round(k0)
    se.k0 <- max(0, se.k0)
    if (verbose) 
      cat("Iteration:", iter, "\tmissing =", k0, "\t  b =", 
        ifelse(side == "right", -1 * b, b), "\n")
  }
  if (k0 > 0) {
    if (side == "right") {
      yi.c <- -1 * (yi.c - b)
    }
    else {
      yi.c <- yi.c - b
    }
    yi.fill <- c(x$yi.f, -1 * yi.c[(k - k0 + 1):k])
    vi.fill <- c(x$vi.f, vi[(k - k0 + 1):k])
    weights.fill <- c(x$weights.f, weights[(k - k0 + 1):k])
    ni.fill <- c(x$ni.f, ni[(k - k0 + 1):k])
    attr(yi.fill, "measure") <- x$measure
    res <- rma(yi.fill, vi.fill, weights = weights.fill, 
      ni = ni.fill, intercept = TRUE, method = x$method, 
      weighted = x$weighted, ...)
    res$fill <- c(rep(FALSE, k), rep(TRUE, k0))
    res$ids <- c(x$ids, (x$k.f + 1):(x$k.f + k0))
    if (x$slab.null) {
      res$slab <- c(paste("Study", x$ids), paste("Filled", 
        seq_len(k0)))
    }
    else {
      res$slab <- c(x$slab, paste("Filled", seq_len(k0)))
    }
    res$slab.null <- FALSE
  }
  else {
    res <- x
    res$fill <- rep(FALSE, k)
  }
  res$k0 <- k0
  res$se.k0 <- se.k0
  res$side <- side
  res$k0.est <- estimator
  if (estimator == "R0") {
    m <- -1:(k0 - 1)
    res$pval <- 1 - sum(choose(0 + m + 1, m + 1) * 0.5^(0 + m + 2))
  }
  else {
    res$pval <- NA
  }
  class(res) <- c("rma.uni.trimfill", class(res))
  return(res)
}

##############################
check.counts <- function(n00, n01, n10, n11){
  idx.double.zero <- which(n00 + n10 == 0 | n01 + n11 == 0)
  if(length(idx.double.zero) > 0){
    if(length(n00) - length(idx.double.zero) >= 5){
      n00 <- n00[-idx.double.zero]
      n01 <- n01[-idx.double.zero]
      n10 <- n10[-idx.double.zero]
      n11 <- n11[-idx.double.zero]
    }else{
      # avoid removing too many double-zero studies
      n00[idx.double.zero] <- n00[idx.double.zero] + 0.01
      n01[idx.double.zero] <- n01[idx.double.zero] + 0.01
      n10[idx.double.zero] <- n10[idx.double.zero] + 0.01
      n11[idx.double.zero] <- n11[idx.double.zero] + 0.01
    }
  }

  idx.zero <- which(n00 == 0 | n01 == 0 | n10 == 0 | n11 == 0)
  if(length(idx.zero) > 0){
    n00[idx.zero] <- n00[idx.zero] + 0.5
    n01[idx.zero] <- n01[idx.zero] + 0.5
    n10[idx.zero] <- n10[idx.zero] + 0.5
    n11[idx.zero] <- n11[idx.zero] + 0.5
  }
  out <- list(n00 = n00, n01 = n01, n10 = n10, n11 = n11)
  return(out)
}

##############################
find.counts <- function(n0., n1., lor, lor.var, p0.ori){
  r <- exp(lor)
  s <- lor.var
  a <- (1 - r)^2 + n1.*r*s
  b <- -2*(1 - r) - n1.*r*s
  c <- 1 + n1./n0.*r
  D <- b^2 - 4*a*c
  if(D < 0) p0 <- c(0, 1)
  if(D == 0){
    p0 <- -b/(2*a)
    if(p0 < 0) p0 <- 0
    if(p0 > 1) p0 <- 1
  }
  if(D > 0){
    p0.sol1 <- (-b - sqrt(D))/(2*a)
    p0.sol2 <- (-b + sqrt(D))/(2*a)
    p0 <- c(p0.sol1, p0.sol2)
    p0[p0 < 0] <- 0
    p0[p0 > 1] <- 1
  }
  if(length(p0) > 1){
    idx <- which(p0 - p0.ori == min(p0 - p0.ori))
    p0 <- p0[idx]
    p0 <- p0[1]
  }
  p1 <- r*p0/(1 - p0 + r*p0)
  n01 <- n0.*p0
  n00 <- n0.*(1 - p0)
  n11 <- n1.*p1
  n10 <- n1.*(1 - p1)
  out <- list(n00 = n00, n01 = n01, n10 = n10, n11 = n11)
  return(out)
}