https://github.com/cran/MADPop
Raw File
Tip revision: be291479202d9ca826914b9bf0fe0b8efa26e6c3 authored by Martin Lysy on 22 August 2022, 08:20:12 UTC
version 1.1.4
Tip revision: be29147
UM.eqtest.R
#' Equality tests for two multinomial samples
#'
#' Generate multinomial samples from a common probability vector and calculate the Chi-square and Likelihood Ratio test statistics.
#'
#' @param N1 Size of sample 1.
#' @param N2 Size of sample 2.
#' @param p0 Common probability vector from which to draw the multinomial samples.  Can also be a matrix, in which case each simulation randomly draws with replacement from the rows of p0.
#' @param nreps Number of replications of the simulation.
#' @param verbose Logical.  If \code{TRUE} prints message every \code{5000} replications.
#' @details The chi-squared and likelihood ratio test statistics are calculated from multinomial samples \eqn{(Y_1^1, Y_2^1), \ldots, (Y_1^M, Y_2^M)}{(Y_11, Y_21),\ldots,(Y_1M, Y_2M)}, where
#' \deqn{
#'   Y_k^m \stackrel{\textrm{ind}}{\sim} \textrm{Multinomial}(N_k, p_0^m),
#' }{
#'   Y_km ~ind Multinomial(N_k, p_m),
#' }
#' where \eqn{p_0^m}{p_m} is the \eqn{m}th row of \code{p0}.
#' @return An \code{nreps x 2} matrix with the simulated chi-squared and LR values.
#' @examples
#' # bootstrapped p-value calculation against equal genotype proportions
#' # in lakes Michipicoten and Simcoe
#'
#' # contingency table
#' popId <- c("Michipicoten", "Simcoe")
#' ctab <- UM.suff(fish215[fish215$Lake %in% popId,])$tab
#' ctab
#'
#' # MLE of probability vector
#' p.MLE <- colSums(ctab)/sum(ctab)
#' # sample sizes
#' N1 <- sum(ctab[1,]) # Michipicoten
#' N2 <- sum(ctab[2,]) # Simcoe
#'
#' # bootstrapped test statistics (chi^2 and LRT)
#' T.boot <- UM.eqtest(N1 = N1, N2 = N2, p0 = p.MLE, nreps = 1e3)
#'
#' # observed test statistics
#' T.obs <- c(chi2 = chi2.stat(ctab), LRT = LRT.stat(ctab))
#' # p-values
#' rowMeans(t(T.boot) > T.obs)
#' @importFrom stats rmultinom
#' @export
UM.eqtest <- function(N1, N2, p0, nreps, verbose = TRUE) {
  N <- N1+N2
  P0 <- p0
  if(is.matrix(P0)) {
    Np0 <- nrow(P0)
  } else {
    Np0 <- 1
    p0 <- P0
  }
  # output
  boot.out <- matrix(NA, nreps, 2)
  colnames(boot.out) <- c("chi2", "LRT")
  for(ii in 1:nreps) {
    if(verbose && (ii%%5e3 == 0)) message("bootstrap sample ", ii, "/", nreps)
    if(Np0 > 1) {
      p0 <- P0[sample(Np0, 1),]
    }
    tab.sim <- rbind(c(rmultinom(1, size = N1, prob = p0)),
                     c(rmultinom(1, size = N2, prob = p0)))
    boot.out[ii,1] <- chi2.stat(tab.sim)
    boot.out[ii,2] <- LRT.stat(tab.sim)
  }
  boot.out
}
back to top