Creating R Squared function for CPLM package

Question

For my graduate research I'm using the CPLM package (specifically the cpglmm function) to account for zero-inflated data (Tweedie compound Poisson distribution) in a data set looking at the effects of logging on breeding bird densities. This isn't a widely used package like lme4, nlme, etc. Therefore, the model validation methods that can be used on these more commonly used packages cannot be used on cpglmm.

I'm currently at the stage of describing the fit of my models and am trying to calculate R-squared values, both marginal and conditional. Unfortunately I cannot use the r2glmm package or MuMln to calculate R-squared values because they do not support cpglmm. Therefore, I've had to calculate those values manually through an example found here (example found in Appendix 6 under cpglmm parasite models, pg. 33). Here's the script from that example:

# Fit null model without fixed effects (but including all random effects)
parmodCPr <- cpglmm(Parasite ~ 1 + (1 | Population) + (1 | Container), data = DataAll)

# Fit alternative model including fixed and all random effects
parmodCPf <- cpglmm(Parasite ~ Sex + Treatment + Habitat + (1 | Population) +
                  (1 | Container), data = DataAll)

# Calculation of the variance in fitted values
VarF <- var(as.vector(model.matrix(parmodCPf) %*% fixef(parmodCPf)))

# getting the observation-level variance Null model
phiN <- parmodCPr@phi # the dispersion parameter
pN <- parmodCPr@p # the index parameter
mu <- exp(fixef(parmodCPr) + 0.5 * (VarCorr(parmodCPr)$Population[1] + VarCorr(parmodCPr)$Container[1]))
VarOdN <- phiN * mu^(pN - 2) # the delta method

# Full model
phiF <- parmodCPf@phi # the dispersion parameter
pF <- parmodCPf@p # the index parameter
VarOdF <- phiF * mu^(pF - 2) # the delta method

# R2[GLMM(m)] - marginal R2[GLMM]; using the delta method observation-level variance
R2glmmM <- VarF/(VarF + sum(as.numeric(VarCorr(parmodCPf))) + VarOdF)

# R2[GLMM(c)] - conditional R2[GLMM] for full model
R2glmmC <- (VarF + sum(as.numeric(VarCorr(parmodCPf))))/(VarF + sum(as.numeric(VarCorr(parmodCPf))) +
                                                       VarOdF)

What I would like to be able to do is write a function in R using this code outputting both the marginal and conditional R-squared values (RglmmM and RglmmC) with my models as the input. I'd greatly appreciate any help with this problem. Hopefully I have supplied enough information.

Thanks.

Answer 1

Believe I figured it out. Here's an example I wrote up:

R2glmm <- function(model){

  # Calculation of the variance in fitted values
  VarALT <- var(as.vector(model.matrix(model) %*% fixef(model)))

  # getting the observation-level variance Null model
  phiNULL <- NULLmodel$phi # the dispersion parameter
  pNULL <- NULLmodel$p # the index parameter
  mu <- exp(fixef(NULLmodel) + 0.5 * (VarCorr(NULLmodel)$YEAR[1])) 
  VarOdNULL <- phiNULL * mu^(pNULL - 2) # the delta method

  # Alternate model
  phiALT <- model$phi # the dispersion parameter
  pALT <- model$p # the index parameter
  VarOdALT <- phiALT * mu^(pALT - 2) # the delta method

  # R2[GLMM(m)] - marginal R2[GLMM]; using the delta method observation-level variance
  R2glmmM <- VarALT/(VarALT + sum(as.numeric(VarCorr(model))) + VarOdALT)

  # R2[GLMM(c)] - conditional R2[GLMM] for full model
  R2glmmC <- (VarALT + sum(as.numeric(VarCorr(model))))/(VarALT + sum(as.numeric(VarCorr(model))) + VarOdALT)

  return(c(R2glmmM, R2glmmC))

  }

Variables containing ALT refers to the alternate model. "model" represents any cpglmm model you need to run through the function.

Hope this helps someone out. Been working on this problem and other related ones for ages now.