still very broken

vincentarelbundock · Sep 28, 2023 · c2bb075 · c2bb075
1 parent af0dabd
commit c2bb075
Show file tree

Hide file tree

Showing 4 changed files with 17 additions and 6 deletions.
diff --git a/R/get_se_delta.R b/R/get_se_delta.R
@@ -109,7 +109,8 @@ get_se_delta <- function(model,
     # align J and V: This might be a problematic hack, but I have not found examples yet.
     V <- vcov
     if (!isTRUE(ncol(J) == ncol(V))) {
-        beta <- get_coef(model)
+        # dots important for full=TRUE in glmmTMB
+        beta <- get_coef(model, ...)
         # Issue #718: ordinal::clm in test-pkg-ordinal.R
         if (anyNA(beta) && anyDuplicated(names(beta)) && ncol(J) > ncol(V) && ncol(J) == length(beta) && length(stats::na.omit(beta)) == ncol(V)) {
             J <- J[, !is.na(beta), drop = FALSE]
@@ -118,8 +119,9 @@ get_se_delta <- function(model,
             if (length(cols) == 0) {
                 insight::format_error("The jacobian does not match the variance-covariance matrix.")
             }
-            V <- V[cols, cols, drop = FALSE]
-            J <- J[, cols, drop = FALSE]
+            # do not re-order, because it breaks glmmTMB where all fixed are called beta and random are b
+            V <- V[colnames(V) %in% cols, colnames(V) %in% cols, drop = FALSE]
+            J <- J[, colnames(J) %in% cols, drop = FALSE]
         }
     }
 

diff --git a/R/methods_glmmTMB.R b/R/methods_glmmTMB.R
@@ -65,6 +65,8 @@ set_coef.glmmTMB <- function(model, coefs, ...) {
     out <- model
     bbeta <- coefs[names(coefs) %in% c("beta", "b")]
     out$fit$parfull[names(out$fit$parfull) %in% names(bbeta)] <- bbeta
+    out$obj$env$last.par[names(out$obj$env$last.par) %in% names(bbeta)] <- bbeta
+    out$obj$env$last.par.best[names(out$obj$env$last.par.best) %in% names(bbeta)] <- bbeta
     beta <- coefs[names(coefs) %in% c("beta")]
     out$fit$par[names(out$fit$par) %in% names(beta)] <- beta
     out$sdr$par.fixed[names(out$sdr$par.fixed) %in% names(beta)] <- beta

diff --git a/R/sanity_dots.R b/R/sanity_dots.R
@@ -31,7 +31,7 @@ sanity_dots <- function(model, calling_function = NULL, ...) {
                             "sample_new_levels", "dpar", "resp")
     valid[["brmsfit_multiple"]] <- valid[["brmsfit"]]
     valid[["selection"]] <- c("part") # sampleSelection
-    valid[["glmmTMB"]] <- c("re.form", "allow.new.levels", "zitype") # glmmTMB
+    valid[["glmmTMB"]] <- c("re.form", "allow.new.levels", "zitype", "full") # glmmTMB
     valid[["bam"]] <- c("exclude") # mgcv
     valid[["rlmerMod"]] <- c("re.form", "allow.new.levels")
     valid[["gamlss"]] <- c("what", "safe") # gamlss

diff --git a/inst/tinytest/test-pkg-glmmTMB.R b/inst/tinytest/test-pkg-glmmTMB.R
@@ -316,19 +316,26 @@ se2 <- predict(m, se.fit = TRUE)$se.fit
 V <- vcov(m)$cond
 J <- model.matrix(m)
 se3 <- sqrt(diag(J %*% (V %*% t(J))))
-se4 <- get_se_manual(m, random = FALSE)
+se4 <- get_se_manual(m, full = FALSE)
 
 all.equal(unname(se1), unname(se2))
 all.equal(unname(se3), unname(se4))
 
 # mismatch
 Q
 pkgload::load_all()
-predictions(m, full=FALSE)$std.error |> head()
+predictions(m, full=TRUE)$std.error |> head()
+
+predictions(m, full=TRUE) |> attr("jacobian") |> head()
+
+predict(m, se.fit=TRUE)$se.fit |> head()
 
 se3 |> head()
 se2 |> head()
 
+get_coef(m, full = TRUE)
+get_vcov(m, full = TRUE)
+
 
 m <- glmmTMB(got ~ age * hiv2004 + (1 | villnum), data = dat)
 m <- glmmTMB(got ~ age * hiv2004, data = dat)