Support svy2lme (#898)

* Support svy2lme

* draft

* fix

* add get_sigma

* add tests

* remove test

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: insight
 Title: Easy Access to Model Information for Various Model Objects
-Version: 0.20.1.9
+Version: 0.20.1.10
 Authors@R: 
     c(person(given = "Daniel",
              family = "Lüdecke",
@@ -195,6 +195,7 @@ Suggests:
     statmod,
     survey,
     survival,
+    svylme,
     testthat,
     tinytable (>= 0.1.0),
     TMB,

NAMESPACE

@@ -177,6 +177,7 @@ S3method(find_formula,selection)
 S3method(find_formula,sem)
 S3method(find_formula,stanmvreg)
 S3method(find_formula,stanreg)
+S3method(find_formula,svy2lme)
 S3method(find_formula,svy_vglm)
 S3method(find_formula,systemfit)
 S3method(find_formula,tobit)
@@ -303,6 +304,7 @@ S3method(find_parameters,stanmvreg)
 S3method(find_parameters,stanreg)
 S3method(find_parameters,summary.lm)
 S3method(find_parameters,survreg)
+S3method(find_parameters,svy2lme)
 S3method(find_parameters,systemfit)
 S3method(find_parameters,tobit)
 S3method(find_parameters,vgam)
@@ -527,6 +529,7 @@ S3method(get_df,phylolm)
 S3method(get_df,poissonirr)
 S3method(get_df,poissonmfx)
 S3method(get_df,probitmfx)
+S3method(get_df,svy2lme)
 S3method(get_family,default)
 S3method(get_family,list)
 S3method(get_family,model_fit)
@@ -700,6 +703,7 @@ S3method(get_parameters,stanmvreg)
 S3method(get_parameters,stanreg)
 S3method(get_parameters,summary.lm)
 S3method(get_parameters,survreg)
+S3method(get_parameters,svy2lme)
 S3method(get_parameters,systemfit)
 S3method(get_parameters,tobit)
 S3method(get_parameters,vgam)
@@ -910,6 +914,7 @@ S3method(get_statistic,selection)
 S3method(get_statistic,sem)
 S3method(get_statistic,summary.lm)
 S3method(get_statistic,survreg)
+S3method(get_statistic,svy2lme)
 S3method(get_statistic,svy_vglm)
 S3method(get_statistic,svyglm)
 S3method(get_statistic,svyglm.nb)
@@ -1144,6 +1149,7 @@ S3method(link_function,speedlm)
 S3method(link_function,stanmvreg)
 S3method(link_function,survfit)
 S3method(link_function,survreg)
+S3method(link_function,svy2lme)
 S3method(link_function,svy_vglm)
 S3method(link_function,svyolr)
 S3method(link_function,systemfit)
@@ -1270,6 +1276,7 @@ S3method(link_inverse,speedlm)
 S3method(link_inverse,stanmvreg)
 S3method(link_inverse,survfit)
 S3method(link_inverse,survreg)
+S3method(link_inverse,svy2lme)
 S3method(link_inverse,svy_vglm)
 S3method(link_inverse,svyolr)
 S3method(link_inverse,systemfit)
@@ -1423,6 +1430,7 @@ S3method(model_info,stanreg)
 S3method(model_info,summary.lm)
 S3method(model_info,survfit)
 S3method(model_info,survreg)
+S3method(model_info,svy2lme)
 S3method(model_info,svy_vglm)
 S3method(model_info,svyolr)
 S3method(model_info,systemfit)
@@ -1567,6 +1575,7 @@ S3method(n_parameters,rlmerMod)
 S3method(n_parameters,sim.merMod)
 S3method(n_parameters,stanmvreg)
 S3method(n_parameters,stanreg)
+S3method(n_parameters,svy2lme)
 S3method(n_parameters,vgam)
 S3method(n_parameters,wbm)
 S3method(n_parameters,zeroinfl)

NEWS.md

@@ -4,6 +4,8 @@
 
 * Support for models of class `glmgee` (package *glmtoolbox*).
 
+* Support for models of class `svy2lme` (package *svylme*).
+
 ## General
 
 * Massive overhaul of `get_variance()`. The function should be now more

R/find_formula.R

@@ -1240,6 +1240,9 @@ find_formula.cgamm <- find_formula.merMod
 #' @export
 find_formula.coxme <- find_formula.merMod
 
+#' @export
+find_formula.svy2lme <- find_formula.merMod
+
 #' @export
 find_formula.HLfit <- find_formula.merMod
 

R/find_parameters.R

@@ -642,11 +642,11 @@ find_parameters.aovlist <- function(x, flatten = FALSE, ...) {
 find_parameters.rqs <- function(x, flatten = FALSE, ...) {
   sc <- suppressWarnings(summary(x))
 
-  if (all(unlist(lapply(sc, is.list), use.names = FALSE))) {
-    pars <- list(conditional = rownames(stats::coef(sc[[1]])))
-  } else {
+  if (!all(unlist(lapply(sc, is.list), use.names = FALSE))) {
     return(find_parameters.default(x, flatten = flatten, ...))
   }
+
+  pars <- list(conditional = rownames(stats::coef(sc[[1]])))
   pars$conditional <- text_remove_backticks(pars$conditional)
 
   if (flatten) {

R/find_parameters_mixed.R

@@ -224,6 +224,30 @@ find_parameters.merModList <- function(x,
 }
 
 
+#' @export
+find_parameters.svy2lme <- function(x,
+                                    effects = c("all", "fixed", "random"),
+                                    flatten = FALSE,
+                                    ...) {
+  effects <- match.arg(effects)
+
+  # we extract random effects only when really necessary, to save
+  # computational time. In particular model with large sample and
+  # many random effects groups may take some time to return random effects
+
+  if (effects == "fixed") {
+    l <- list(conditional = names(stats::coef(x)))
+  } else {
+    l <- compact_list(list(
+      conditional = names(stats::coef(x)),
+      random = stats::setNames(as.list(unname(x$znames)), names(x$znames))
+    ))
+  }
+
+  .filter_parameters(l, effects = effects, flatten = flatten)
+}
+
+
 #' @export
 find_parameters.HLfit <- function(x,
                                   effects = c("all", "fixed", "random"),

R/find_statistic.R

@@ -103,6 +103,7 @@ find_statistic <- function(x, ...) {
     "pb1", "pb2", "polr", "phylolm",
     "rlm", "rms", "rlmerMod", "rq", "rqs", "rqss",
     "selection", "speedlm", "spml", "summary.lm", "svyglm", "svyolr", "systemfit",
+    "svy2lme",
     "truncreg",
     "varest",
     "wbm", "wblm",

R/get_df.R

@@ -171,6 +171,17 @@ get_df.model_fit <- function(x, type = "residual", verbose = TRUE, ...) {
 }
 
 
+#' @export
+get_df.svy2lme <- function(x, type = "residual", verbose = TRUE, ...) {
+  type <- match.arg(tolower(type), choices = c("residual", "model", "normal"))
+  if (type == "model") {
+    .model_df(x)
+  } else {
+    Inf
+  }
+}
+
+
 #' @export
 get_df.mmrm <- function(x, type = "residual", verbose = TRUE, ...) {
   type <- match.arg(tolower(type), choices = c("residual", "model", "normal"))

R/get_parameters_mixed.R

@@ -224,6 +224,19 @@ get_parameters.glmmadmb <- get_parameters.merMod
 #' @export
 get_parameters.lme <- get_parameters.merMod
 
+
+#' @export
+get_parameters.svy2lme <- function(x, ...) {
+  l <- list(conditional = stats::coef(x))
+  fixed <- data.frame(
+    Parameter = names(l$conditional),
+    Estimate = unname(l$conditional),
+    stringsAsFactors = FALSE
+  )
+  text_remove_backticks(fixed)
+}
+
+
 #' @export
 get_parameters.merModList <- function(x, ...) {
   s <- suppressWarnings(summary(x))

R/get_sigma.R

@@ -118,6 +118,11 @@ get_sigma <- function(x, ci = NULL, verbose = TRUE) {
 }
 
 
+.get_sigma.svy2lme <- function(x, ...) {
+  sqrt(as.vector(x$s2))
+}
+
+
 .get_sigma.model_fit <- function(x, verbose = TRUE, ...) {
   .get_sigma(x$fit, verbose = verbose)
 }

R/get_statistic.R

@@ -1414,6 +1414,19 @@ get_statistic.ivprobit <- function(x, ...) {
 }
 
 
+#' @export
+get_statistic.svy2lme <- function(x, ...) {
+  out <- data.frame(
+    Parameter = rownames(x$beta),
+    Statistic = as.vector(x$beta / sqrt(diag(x$Vbeta))),
+    stringsAsFactors = FALSE
+  )
+  out <- text_remove_backticks(out)
+  attr(out, "statistic") <- find_statistic(x)
+  out
+}
+
+
 #' @export
 get_statistic.HLfit <- function(x, ...) {
   utils::capture.output(s <- summary(x)) # nolint

R/is_model.R

@@ -144,7 +144,7 @@ is_regression_model <- function(x) {
     "Sarlm", "scam", "selection", "sem", "SemiParBIV", "serp", "slm", "speedlm",
     "speedglm", "splmm", "spml", "stanmvreg", "stanreg", "summary.lm",
     "survfit", "survreg", "survPresmooth", "svychisq", "svyglm", "svy_vglm",
-    "svyolr", "svytable", "systemfit",
+    "svyolr", "svytable", "systemfit", "svy2lme",
 
     # t --------------------
     "t1way", "t2way", "t3way", "test_mediation", "tobit", "trendPMCMR",

R/is_model_supported.R

@@ -109,7 +109,7 @@ supported_models <- function() {
     # s ----------------------------
     "Sarlm", "scam", "selection", "sem", "semLm", "semLme", "SemiParBIV", "serp",
     "slm", "speedlm", "speedglm", "stanfit", "stanmvreg", "stanreg", "summary.lm",
-    "survfit", "survreg", "svy_vglm", "svychisq", "svyglm", "svyolr",
+    "survfit", "survreg", "svy_vglm", "svychisq", "svyglm", "svyolr", "svy2lme",
 
     # t ----------------------------
     "t1way", "tobit", "trimcibt", "truncreg",

R/link_function.R

@@ -171,6 +171,9 @@ link_function.RM <- link_function.lm
 #' @export
 link_function.afex_aov <- link_function.lm
 
+#' @export
+link_function.svy2lme <- link_function.lm
+
 
 # General family ---------------------------------
 

R/link_inverse.R

@@ -201,6 +201,9 @@ link_inverse.speedlm <- link_inverse.lm
 #' @export
 link_inverse.afex_aov <- link_inverse.lm
 
+#' @export
+link_inverse.svy2lme <- link_inverse.lm
+
 
 
 

R/model_info.R

@@ -1123,6 +1123,12 @@ model_info.svy_vglm <- function(x, verbose = TRUE, ...) {
 }
 
 
+#' @export
+model_info.svy2lme <- function(x, verbose = TRUE, ...) {
+  .make_family(x = x, verbose = verbose, ...)
+}
+
+
 #' @export
 model_info.glmmTMB <- function(x, ...) {
   # installed?

R/n_parameters.R

@@ -106,6 +106,8 @@ n_parameters.sim.merMod <- n_parameters.merMod
 #' @export
 n_parameters.wbm <- n_parameters.merMod
 
+#' @export
+n_parameters.svy2lme <- n_parameters.merMod
 
 
 

inst/WORDLIST

@@ -137,6 +137,7 @@ modelled
 modelling
 multcomp
 mvord
+nbinom
 nd
 nestedLogit
 nlme
@@ -167,6 +168,7 @@ specificities
 stanreg
 strengejacke
 svyVGAM
+svylme
 systemfit
 terciles
 th