Fix issues with LOGNO family (#899)

* Fix issues with LOGNO family * fix * fix * styler * fix
easystats · Jul 4, 2024 · 90906be · 90906be
1 parent de9c471
commit 90906be
Show file tree

Hide file tree

Showing 6 changed files with 36 additions and 16 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: insight
 Title: Easy Access to Model Information for Various Model Objects
-Version: 0.20.1.10
+Version: 0.20.1.11
 Authors@R: 
     c(person(given = "Daniel",
              family = "Lüdecke",

diff --git a/NEWS.md b/NEWS.md
@@ -42,6 +42,9 @@
 * `null_model()` now correctly handles zero-inflated models from package
   *glmmTMB*.
 
+* Fixed issues in `link_inverse()` and `link_function()` for models of class
+  `gamlss` from `LOGNO()` family.
+
 # insight 0.20.1
 
 ## Bug fixes

diff --git a/R/link_function.R b/R/link_function.R
@@ -606,13 +606,18 @@ link_function.glmm <- function(x, ...) {
 link_function.gamlss <- function(x, what = c("mu", "sigma", "nu", "tau"), ...) {
   what <- match.arg(what)
   faminfo <- get(x$family[1], asNamespace("gamlss"))()
-  switch(what,
-    mu = faminfo$mu.linkfun,
-    sigma = faminfo$sigma.linkfun,
-    nu = faminfo$nu.linkfun,
-    tau = faminfo$tau.linkfun,
-    faminfo$mu.linkfun
-  )
+  # exceptions
+  if (faminfo$family[1] == "LOGNO") {
+    function(mu) log(mu)
+  } else {
+    switch(what,
+      mu = faminfo$mu.linkfun,
+      sigma = faminfo$sigma.linkfun,
+      nu = faminfo$nu.linkfun,
+      tau = faminfo$tau.linkfun,
+      faminfo$mu.linkfun
+    )
+  }
 }
 
 

diff --git a/R/link_inverse.R b/R/link_inverse.R
@@ -643,13 +643,18 @@ link_inverse.brmsfit <- function(x, ...) {
 link_inverse.gamlss <- function(x, what = c("mu", "sigma", "nu", "tau"), ...) {
   what <- match.arg(what)
   faminfo <- get(x$family[1], asNamespace("gamlss"))()
-  switch(what,
-    mu = faminfo$mu.linkinv,
-    sigma = faminfo$sigma.linkinv,
-    nu = faminfo$nu.linkinv,
-    tau = faminfo$tau.linkinv,
-    faminfo$mu.linkinv
-  )
+  # exceptions
+  if (faminfo$family[1] == "LOGNO") {
+    function(eta) pmax(exp(eta), .Machine$double.eps)
+  } else {
+    switch(what,
+      mu = faminfo$mu.linkinv,
+      sigma = faminfo$sigma.linkinv,
+      nu = faminfo$nu.linkinv,
+      tau = faminfo$tau.linkinv,
+      faminfo$mu.linkinv
+    )
+  }
 }
 
 

diff --git a/tests/testthat/test-gamlss.R b/tests/testthat/test-gamlss.R
@@ -154,3 +154,10 @@ test_that("find_formula works with namespace colons", {
     ignore_attr = TRUE
   )
 })
+
+test_that("link_inv for LOGNO", {
+  data(abdom, package = "gamlss.data")
+  m1 <- gamlss::gamlss(y ~ x, family = "LOGNO", data = abdom)
+  expect_equal(link_inverse(m1)(0.2), exp(0.2), tolerance = 1e-4)
+  expect_equal(link_function(m1)(0.2), log(0.2), tolerance = 1e-4)
+})
diff --git a/tests/testthat/test-svylme.R b/tests/testthat/test-svylme.R
@@ -53,7 +53,7 @@ withr::with_environment(
         find_formula(m1),
         list(
           conditional = api00 ~ ell + mobility + api99,
-          random = ~1 + api99 | dnum
+          random = ~ 1 + api99 | dnum
         ),
         ignore_attr = TRUE
       )