From bfb28b1364d1ff8ebbc72b844c516b925dccec64 Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Fri, 6 Oct 2023 16:13:52 +0200
Subject: [PATCH] Support dcchoice Fixes
 https://github.com/easystats/performance/issues/637

---
 DESCRIPTION       |  2 +-
 NAMESPACE         |  4 ++++
 R/link_function.R |  6 ++++++
 R/link_inverse.R  |  6 ++++++
 R/model_info.R    | 14 ++++++++++++++
 R/n_obs.R         |  8 ++++++++
 6 files changed, 39 insertions(+), 1 deletion(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index cbfd5740f..4fef6ec1a 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.19.5.12
+Version: 0.19.5.13
 Authors@R: 
     c(person(given = "Daniel",
              family = "Lüdecke",
diff --git a/NAMESPACE b/NAMESPACE
index dadc4f9a5..b4139c593 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1049,6 +1049,7 @@ S3method(link_function,cph)
 S3method(link_function,crch)
 S3method(link_function,crq)
 S3method(link_function,crqs)
+S3method(link_function,dbchoice)
 S3method(link_function,default)
 S3method(link_function,feglm)
 S3method(link_function,feis)
@@ -1168,6 +1169,7 @@ S3method(link_inverse,cph)
 S3method(link_inverse,crch)
 S3method(link_inverse,crq)
 S3method(link_inverse,crqs)
+S3method(link_inverse,dbchoice)
 S3method(link_inverse,default)
 S3method(link_inverse,feglm)
 S3method(link_inverse,feis)
@@ -1299,6 +1301,7 @@ S3method(model_info,crch)
 S3method(model_info,crq)
 S3method(model_info,crqs)
 S3method(model_info,data.frame)
+S3method(model_info,dbchoice)
 S3method(model_info,default)
 S3method(model_info,deltaMethod)
 S3method(model_info,earth)
@@ -1439,6 +1442,7 @@ S3method(n_obs,cpglmm)
 S3method(n_obs,crq)
 S3method(n_obs,crqs)
 S3method(n_obs,crr)
+S3method(n_obs,dbchoice)
 S3method(n_obs,default)
 S3method(n_obs,eglm)
 S3method(n_obs,emm_list)
diff --git a/R/link_function.R b/R/link_function.R
index b4ed03be6..9a5299460 100644
--- a/R/link_function.R
+++ b/R/link_function.R
@@ -389,6 +389,12 @@ link_function.model_fit <- link_function.logitmfx
 # Other models -----------------------------
 
 
+#' @export
+link_function.dbchoice <- function(x, ...) {
+  x$f.stage$family$linkfun
+}
+
+
 #' @export
 link_function.Rchoice <- function(x, ...) {
   stats::make.link(link = x$link)$linkfun
diff --git a/R/link_inverse.R b/R/link_inverse.R
index 9f10b972b..f85d55570 100644
--- a/R/link_inverse.R
+++ b/R/link_inverse.R
@@ -386,6 +386,12 @@ link_inverse.negbinirr <- link_inverse.logitmfx
 
 # Other models ----------------------------
 
+#' @export
+link_inverse.dbchoice <- function(x, ...) {
+  x$f.stage$family$linkinv
+}
+
+
 #' @export
 link_inverse.Rchoice <- function(x, ...) {
   stats::make.link(link = x$link)$linkinv
diff --git a/R/model_info.R b/R/model_info.R
index db9a43474..63d36186b 100644
--- a/R/model_info.R
+++ b/R/model_info.R
@@ -785,6 +785,20 @@ model_info.Rchoice <- function(x, ...) {
 }
 
 
+#' @export
+model_info.dbchoice <- function(x, ...) {
+  faminfo <- x$f.stage$family
+  .make_family(
+    x = x,
+    fitfam = faminfo$family,
+    logit.link = faminfo$link == "logit",
+    multi.var = FALSE,
+    link.fun = faminfo$link,
+    ...
+  )
+}
+
+
 #' @export
 model_info.ivprobit <- function(x, ...) {
   .make_family(
diff --git a/R/n_obs.R b/R/n_obs.R
index b0e19277e..f54c19c4a 100644
--- a/R/n_obs.R
+++ b/R/n_obs.R
@@ -100,11 +100,19 @@ n_obs.glm <- function(x, disaggregate = FALSE, ...) {
 #' @export
 n_obs.censReg <- n_obs.default
 
+
 #' @export
 n_obs.nestedLogit <- function(x, disaggregate = FALSE, ...) {
   lapply(x$models, n_obs)
 }
 
+
+#' @export
+n_obs.dbchoice <- function(x, ...) {
+  stats::nobs(x)
+}
+
+
 #' @rdname n_obs
 #' @export
 n_obs.svyolr <- function(x, weighted = FALSE, ...) {