test-modelSelection-enum.R
In mombf: Model Selection with Bayesian Methods and Information Criteria

context("Test modelSelection with enumerate=TRUE")
library("mombf")

source(test_path("data-for-tests.R"))
tolerance <- 1e-5

patrick::with_parameters_test_that(
  "modelSelection without groups works for", {
    pDelta <- modelbbprior(1,1)
    log <- capture.output(
      fit1 <- modelSelection(y=y3, x=X3, priorCoef=pCoef, priorDelta=pDelta, enumerate=TRUE, family=family, priorSkew=pCoef),
      fit2 <- modelSelection(y3~X3[,2]+X3[,3]+X3[,4], priorCoef=pCoef, priorDelta=pDelta, enumerate=TRUE, family=family, priorSkew=pCoef),
      fit3 <- modelSelection(as.formula("y~X2+X3+X4"), data=data.frame(X3, y=y3), priorCoef=pCoef, priorDelta=pDelta, enumerate=TRUE, family=family, priorSkew=pCoef)
    )
    pp1 <- postProb(fit1)
    pp2 <- postProb(fit2)
    pp3 <- postProb(fit3)
    expect_equal(pp1$modelid, pp2$modelid)
    expect_equal(pp1$modelid, pp3$modelid)
    expect_equal(pp1$pp, pp2$pp, tolerance=tolerance)
    expect_equal(pp1$pp, pp3$pp, tolerance=tolerance)
  },
  patrick::cases(
    mom_auto=list(family="auto", pCoef=momprior(tau=0.348)),
    mom_normal=list(family="normal", pCoef=momprior(tau=0.348)),
    mom_twopiecenormal=list(family="twopiecenormal", pCoef=momprior(tau=0.348)),
    mom_laplace=list(family="laplace", pCoef=momprior(tau=0.348)),
    mom_twopiecelaplace=list(family="twopiecelaplace", pCoef=momprior(tau=0.348)),
    imom_auto=list(family="auto", pCoef=imomprior(tau=0.348)),
    imom_normal=list(family="normal", pCoef=imomprior(tau=0.348)),
    imom_twopiecenormal=list(family="twopiecenormal", pCoef=imomprior(tau=0.348)),
    imom_laplace=list(family="laplace", pCoef=imomprior(tau=0.348)),
    imom_twopiecelaplace=list(family="twopiecelaplace", pCoef=imomprior(tau=0.348)),
    emom_auto=list(family="auto", pCoef=emomprior(tau=0.348)),
    emom_normal=list(family="normal", pCoef=emomprior(tau=0.348)),
    emom_twopiecenormal=list(family="twopiecenormal", pCoef=emomprior(tau=0.348)),
    emom_laplace=list(family="laplace", pCoef=emomprior(tau=0.348)),
    emom_twopiecelaplace=list(family="twopiecelaplace", pCoef=emomprior(tau=0.348))
  )
)

patrick::with_parameters_test_that(
  "modelSelection with groups works for", {
    pDelta <- modelbbprior(1,1)
    groups <- c(1, 1, 2, 2, 3, 4, 4)
    log <- capture.output(
      fit <- modelSelection(
        y=y6, x=X6, priorCoef=pCoef, priorDelta=pDelta, enumerate=TRUE,
        family=family, priorSkew=pCoef, priorGroup=pCoef, groups=groups
      )
    )
    pprobs <- postProb(fit)
    expect_equal(length(pprobs$modelid), 16)
    expect_equal(as.character(pprobs$modelid[1]), "3,4,6,7")
  },
  patrick::cases(
    mom_normal=list(family="normal", pCoef=momprior(tau=0.348)),
    mom_twopiecenormal=list(family="twopiecenormal", pCoef=momprior(tau=0.348)),
    mom_laplace=list(family="laplace", pCoef=momprior(tau=0.348)),
    mom_twopiecelaplace=list(family="twopiecelaplace", pCoef=momprior(tau=0.348)),
    imom_normal=list(family="normal", pCoef=imomprior(tau=0.348)),
    imom_twopiecenormal=list(family="twopiecenormal", pCoef=imomprior(tau=0.348)),
    imom_laplace=list(family="laplace", pCoef=imomprior(tau=0.348)),
    imom_twopiecelaplace=list(family="twopiecelaplace", pCoef=imomprior(tau=0.348)),
    emom_normal=list(family="normal", pCoef=emomprior(tau=0.348)),
    emom_twopiecenormal=list(family="twopiecenormal", pCoef=emomprior(tau=0.348)),
    emom_laplace=list(family="laplace", pCoef=emomprior(tau=0.348)),
    emom_twopiecelaplace=list(family="twopiecelaplace", pCoef=emomprior(tau=0.348))
  )
)

patrick::with_parameters_test_that(
  "model space prior work in modelSelection:", {
    pCoef <- momprior(tau=0.348)
    log <- capture.output(
      fit <- modelSelection(y=y6, x=X6, priorCoef=pCoef, priorDelta=pDelta, enumerate=TRUE, family="normal")
    )
    expect_output(show(fit))
    pprobs <- postProb(fit)
    expect_true(any(pprobs$modelid[1:5] == "3,4,6,7"))
  },
  test_name=c("uniform", "binomial", "betabinomial", "complex"),
  pDelta=c(modelunifprior(), modelbinomprior(p=0.5), modelbbprior(alpha.p=1, beta.p=1), modelcomplexprior(c=1))
)

patrick::with_parameters_test_that(
  "asymetric binomial prior works in modelSelection (pDelta_pConstr):", {
    i0 <- integer(0)
    constraints <- list(i0, 1, i0, 3, i0, i0, 6)
    log <- capture.output(
      fit <- modelSelection(
        y=y6, x=X6, priorDelta=pDelta, priorConstraints=pConstr,
        enumerate=TRUE, constraints=constraints
      )
    )
    log <- capture.output(
      fit_asym <- modelSelection(
        y=y6, x=X6, priorDelta=modelbinomprior(p=c(0.7, 0.6, 0.2, 0.4)),
        priorConstraints=pConstr, enumerate=TRUE, constraints=constraints
      )
    )
    pprobs <- postProb(fit)
    pprobs_asym <- postProb(fit_asym)
    expect_true(pprobs[1, "modelid"] == "3,4,6,7")
    expect_true(pprobs_asym[1, "modelid"] == "3,4,6,7")
    expect_equal(pprobs[1, "pp"], .9957818, tolerance=tolerance)
    expect_true(abs(pprobs[1, "pp"] - pprobs_asym[1, "pp"]) > tolerance)
  },
  patrick::cases(
    vect_vect=list(pDelta=modelbinomprior(p=c(.5, .5, .5, .5)), pConstr=modelbinomprior(p=c(0.5, .5, .5))),
    vect_scalar=list(pDelta=modelbinomprior(p=c(.5, .5, .5, .5)), pConstr=modelbinomprior(p=0.5)),
    scalar_vect=list(pDelta=modelbinomprior(p=.5), pConstr=modelbinomprior(p=c(0.5, .5, .5))),
    scalar_scalar=list(pDelta=modelbinomprior(p=.5), pConstr=modelbinomprior(p=0.5))
  )
)

patrick::with_parameters_test_that(
  "modelSelection methods in normal family work:", {
    if (method == "Hybrid") {pCoef <- imomprior(tau=0.348)} else {pCoef <- momprior(tau=0.348)}
    pDelta <- modelbbprior(1,1)
    log <- capture.output(
      fit <- modelSelection(
        y=y6, x=X6, priorCoef=pCoef, priorDelta=pDelta, enumerate=TRUE, family="normal",
        method=method, B=200, optimMethod=optimMethod, hess=hess
      )
    )
    expect_output(show(fit))
    pprobs <- postProb(fit)
    expect_true(any(pprobs$modelid[1:5] == "3,4,6,7"))
  },
  patrick::cases(
    auto=list(method="auto", optimMethod="CDA", hess="asymp"),
    laplace_cda=list(method="Laplace", optimMethod="CDA", hess="asymp"),
    laplace_cda_asympdiag=list(method="Laplace", optimMethod="CDA", hess="asympDiagAdj"),
    laplace_lma=list(method="Laplace", optimMethod="LMA", hess="asymp"),
    hybrid=list(method="Hybrid", optimMethod="CDA", hess="asymp"),
    mc=list(method="MC", optimMethod="CDA", hess="asymp"),
    bic=list(method="plugin", optimMethod="CDA", hess="asymp")
  )
)

patrick::with_parameters_test_that(
  "modelSelection methods in laplace family work:", {
    if (method == "Hybrid") {pCoef <- imomprior(tau=0.348)} else {pCoef <- momprior(tau=0.348)}
    pDelta <- modelbbprior(1,1)
    log <- capture.output(
      fit <- modelSelection(
        y=y6, x=X6, priorCoef=pCoef, priorDelta=pDelta, enumerate=TRUE, family="laplace",
        method=method, B=200, optimMethod=optimMethod, hess=hess
      )
    )
    expect_output(show(fit))
    pprobs <- postProb(fit)
    expect_true(any(pprobs$modelid[1:5] == "3,4,6,7"))
  },
  patrick::cases(
    auto=list(method="auto", optimMethod="CDA", hess="asymp"),
    laplace_cda=list(method="Laplace", optimMethod="CDA", hess="asymp"),
    laplace_cda_asympdiag=list(method="Laplace", optimMethod="CDA", hess="asympDiagAdj"),
    laplace_lma=list(method="Laplace", optimMethod="LMA", hess="asymp"),
    hybrid=list(method="Hybrid", optimMethod="CDA", hess="asymp"),
    mc=list(method="MC", optimMethod="CDA", hess="asymp"),
    bic=list(method="plugin", optimMethod="CDA", hess="asymp")
  )
)