tests/regression-tests.R

In effects: Effect Displays for Linear, Generalized Linear, and Other Models

regression.tests <- FALSE

if (regression.tests && require("carData") && require("effects")){

  load("regression-tests.RData")
  
  regressionTest <- function(old, new){
    test.name <- deparse(substitute(new))
    if (!isTRUE(all.equal(old, as.data.frame(new), tolerance=1e-5))) {
      stop("failed regression test ", test.name)
    } else {
      cat("\n", test.name, ": OK", sep="")
    }
  }
  
  m.lm <- lm(prestige~(income + education)*type, data=Duncan)
  eff.lm <- Effect(c("income", "type"), m.lm)
  regressionTest(df.lm, eff.lm)
  
  m.glm <- glm(volunteer ~ sex + neuroticism*extraversion, data=Cowles, family=binomial)
  eff.glm <- Effect(c("neuroticism", "extraversion"), m.glm)
  regressionTest(df.glm, eff.glm)
  
  m.mlm <- lm(cbind(post.test.1, post.test.2, post.test.3) ~ 
                group*(pretest.1 + pretest.2), data = Baumann)
  eff.mlm <- Effect(c("group", "pretest.1"), m.mlm)
  regressionTest(df.mlm, eff.mlm)
  
  if (require(nnet)){
    m.multinom <- multinom(vote ~ age + gender + economic.cond.national +
                           economic.cond.household + Blair + Hague + Kennedy +
                           Europe*political.knowledge, data=BEPS)
    
    eff.multinom <- Effect(c("Europe", "political.knowledge"), m.multinom,
                xlevels=list(political.knowledge=0:3))
    regressionTest(df.multinom, eff.multinom)
  }
  
  if (require(MASS)){
    m.polr <- polr(poverty ~ gender + religion + degree + country*poly(age,3),
                    data=WVS)
    
    eff.polr <- Effect(c("country", "age"), m.polr)
    regressionTest(df.polr, eff.polr)
  }
  
  if (require(nlme)){
    m.lme <- lme(distance ~ age*Sex, data = Orthodont, random = ~ 1)
    eff.lme <- Effect(c("age", "Sex"), m.lme)
    m.gls <- gls(Employed ~ GNP*Population,
        correlation=corAR1(form= ~ Year), data=longley)
    eff.gls <- Effect(c("GNP", "Population"), m.gls)
    regressionTest(df.gls, eff.gls)
  }
  
  if (require(lme4) && require(nlme)){
     data("Orthodont", package="nlme")
     m.lmer <- lmer(distance ~ age*Sex + (1 |Subject), data = Orthodont)
     eff.lmer <- Effect(c("age", "Sex"), m.lmer)
     regressionTest(df.lmer, eff.lmer)
  }
  
  if (require(lme4)){
    m.glmer <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd),
                data = cbpp, family = binomial)
    eff.glmer <- Effect("period", m.glmer)
    regressionTest(df.glmer, eff.glmer)
  }
  
  if (require(lme4) && require(robustlmm)){
      m.rlmer <- rlmer(distance ~ age*Sex + (1 |Subject), data = Orthodont)
      eff.rlmer <- Effect(c("age", "Sex"), m.rlmer)
      regressionTest(df.rlmer, eff.rlmer)
  }
  
  if (require(betareg) && require(lme4)){
     data("GasolineYield", package = "betareg")
     m.betareg <- betareg(yield ~ batch*temp, data = GasolineYield)
     eff.betareg <- Effect(c("batch", "temp"), m.betareg)
     regressionTest(df.betareg, eff.betareg)
  }
  
  if (require(ordinal) && require(MASS)){
    m.clm <- clm(poverty ~ gender + religion + degree + country*poly(age,3),
        data=WVS)
    eff.clm <- Effect(c("country", "age"), m.clm)
    regressionTest(df.clm, eff.clm)
    
    m.clm2 <- clm2(poverty ~ gender + religion + degree + country*poly(age,3),
                 data=WVS)
    eff.clm2 <- Effect(c("country", "age"), m.clm2)
    regressionTest(df.clm2, eff.clm2)
    
    m.clmm <- clmm(SURENESS ~ PROD + (1|RESP) + (1|RESP:PROD), 
                data = soup, link = "logit", threshold = "flexible")
    eff.clmm <- Effect("PROD", m.clmm)
    regressionTest(df.clmm, eff.clmm)
  }
  
  if (require(poLCA)){
    set.seed(123)
    data(election, package="poLCA")
    f <- cbind(MORALG,CARESG,KNOWG,LEADG,DISHONG,INTELG,
               MORALB,CARESB,KNOWB,LEADB,DISHONB,INTELB)~PARTY
    m.poLCA <- poLCA(f, election, nclass=3, nrep=5)
    eff.poLCA <- Effect("PARTY", m.poLCA)
    regressionTest(df.poLCA, eff.poLCA)
  }
  
  if (require(survey)){
    data(api, package="survey")
    dstrat <-svydesign(id=~1,strata=~stype, weights=~pw, data=apistrat, fpc=~fpc)
    m.svyglm <- svyglm(api00~ell*meals+mobility, design=dstrat)
    eff.svyglm <- Effect(c("ell", "meals"), m.svyglm)
    regressionTest(df.svyglm, eff.svyglm)
  }
  
  if(require(nlme) && require(MASS)){
    m.glmmPQL <- glmmPQL(y ~ trt*I(week > 2), random = ~ 1 | ID,
                    family = binomial, data = bacteria)
    eff.glmmPQL <- Effect(c("trt", "week"), m.glmmPQL)
    regressionTest(df.glmmPQL, eff.glmmPQL)
  }

}

# the following commented-out code creates the comparison objects:
#
# df.betareg <- as.data.frame(eff.betareg )
# df.clm <- as.data.frame(eff.clm) 
# df.clm2 <- as.data.frame(eff.clm2)
# df.clmm <- as.data.frame(eff.clmm) 
# df.glm <- as.data.frame(eff.glm) 
# df.glmer <- as.data.frame(eff.glmer) 
# df.gls <- as.data.frame(eff.gls) 
# df.lm <- as.data.frame(eff.lm) 
# df.lme <- as.data.frame(eff.lme) 
# df.lmer <- as.data.frame(eff.lmer) 
# df.mlm <- as.data.frame(eff.mlm) 
# df.multinom <- as.data.frame(eff.multinom) 
# df.poLCA <- as.data.frame(eff.poLCA) 
# df.polr <- as.data.frame(eff.polr) 
# df.rlmer <- as.data.frame(eff.rlmer) 
# df.svyglm <- as.data.frame(eff.svyglm)
# df.glmmPQL <- as.data.frame(eff.glmmPQL)
# 
# 
# save(df.betareg, df.clm, df.clm2, df.clmm, df.glm,
#      df.glmer, df.gls, df.lm, df.lme, df.lmer, df.mlm,
#      df.multinom, df.poLCA, df.polr, df.rlmer, df.svyglm,
#      df.glmmPQL,
#      file="regression-tests.RData")

# To add to regression tests first
# load("regression-tests.RData")