diff --git a/DESCRIPTION b/DESCRIPTION index 9e1960d16b..f15d673a69 100644 --- 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 index daa7f580b4..becd064ce2 100644 --- 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 index 4045602788..2dfd76bcaa 100644 --- 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 index 38f19f1bb4..740aafcee4 100644 --- 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 index 4bc37b5922..7167fa02f1 100644 --- 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 index 06d8d4eb20..fc6431d1e5 100644 --- 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 )