fixes

Author: strengejacke

R/clean_names.R

@@ -1,10 +1,9 @@
 # Clean names -------------------------------------------------------------
 
-
 #' @keywords internal
 .clean_names_frequentist <- function(means, predict = NULL, info = NULL) {
-  names(means)[names(means) == "emmean"] <- .guess_estimate_name(predict, info)
-  names(means)[names(means) == "response"] <- .guess_estimate_name(predict, info)
+  names(means)[names(means) == "emmean"] <- .guess_estimate_name(predict, info = info)
+  names(means)[names(means) == "response"] <- .guess_estimate_name(predict, info = info)
   names(means)[names(means) == "prob"] <- "Probability"
   names(means)[names(means) == "estimate"] <- "Difference"
   names(means)[names(means) == "odds.ratio"] <- "Odds_ratio"

R/format.R

@@ -154,6 +154,7 @@ format.marginaleffects_means <- function(x, model, ci = 0.95, ...) {
   }
   non_focal <- setdiff(colnames(model_data), attr(x, "focal_terms"))
   predict_type <- attributes(x)$predict
+  transform <- attributes(x)$transform
 
   # special attributes we get from "get_marginalcontrasts()"
   comparison <- list(...)$hypothesis
@@ -178,7 +179,7 @@ format.marginaleffects_means <- function(x, model, ci = 0.95, ...) {
     # for simple means, we don't want p-values
     remove_columns <- c(remove_columns, "p")
     # estimate name
-    estimate_name <- .guess_estimate_name(predict_type, info)
+    estimate_name <- .guess_estimate_name(predict_type, transform, info)
   }
 
   # reshape and format columns
@@ -834,12 +835,10 @@ equivalence_columns <- c(
 # based on on which scale predictions were requested
 
 #' @keywords internal
-.guess_estimate_name <- function(predict_type, info) {
+.guess_estimate_name <- function(predict_type, transform = NULL, info) {
   # estimate name
   if (is.null(predict_type)) {
     estimate_name <- "Mean"
-  } else if (predict_type == "context") {
-    estimate_name <- "Estimate"
   } else if (tolower(predict_type) %in% .brms_aux_elements()) {
     # for Bayesian models with distributional parameter
     estimate_name <- tools::toTitleCase(predict_type)
@@ -850,6 +849,19 @@ equivalence_columns <- c(
     # here we add all models that model the probability of an outcome, such as
     # binomial, multinomial, or Bernoulli models
     estimate_name <- "Probability"
+  } else if (
+    predict_type %in%
+      c("none", "link") &&
+      identical(transform, "exp") &&
+      (info$is_binomial || info$is_bernoulli || info$is_multinomial)
+  ) {
+    # here we add all models that have odds ratios as exponentiated coefficients
+    estimate_name <- "Odds_Ratio"
+  } else if (
+    predict_type %in% c("none", "link") && identical(transform, "exp") && (info$is_count)
+  ) {
+    # here we add all models that have IRRs as exponentiated coefficients
+    estimate_name <- "IRR"
   } else if (predict_type == "survival" && info$is_survival) {
     # this is for survival models, where we want to predict the survival probability
     estimate_name <- "Probability"

R/get_contexteffects.R

@@ -1,7 +1,14 @@
 # special contrasts: context effects ----------------------------------------
 # ---------------------------------------------------------------------------
 
-.get_contexteffects <- function(model, my_args, model_info, ...) {
+.get_contexteffects <- function(
+  model,
+  my_args,
+  predict = NULL,
+  transform = NULL,
+  model_info,
+  ...
+) {
   if (model_info$is_linear) {
     out <- marginaleffects::avg_comparisons(
       model,
@@ -13,14 +20,17 @@
     dots <- list(...)
     fun_args <- list(model, variables = my_args$contrast, hypothesis = my_args$comparison)
     # set default for "type" argument, if not provided
-    if (is.null(dots$type)) {
+    if (is.null(predict)) {
       fun_args$type <- "link"
       # if "type" was not provided, also change transform argument. we do
       # this only when user did not provide "type", else - if user provided
       # "type" - we keep the default NULL
-      if (is.null(dots$transform)) {
+      if (is.null(transform)) {
         fun_args$transform <- "exp"
       }
+    } else {
+      fun_args$type <- predict
+      fun_args$transform <- transform
     }
     out <- do.call(marginaleffects::avg_comparisons, c(fun_args, dots))
   }

R/get_marginalcontrasts.R

@@ -102,8 +102,14 @@ get_marginalcontrasts <- function(
     )
     predict <- "response"
   } else if (isTRUE(my_args$context_effects)) {
-    out <- .get_contexteffects(model, my_args, model_info, ...)
-    predict <- "context"
+    out <- .get_contexteffects(model, my_args, predict, transform, model_info, ...)
+    # set defaults, for proper printing
+    if (is.null(predict)) {
+      predict <- "link"
+      if (is.null(transform)) {
+        transform <- "exp"
+      }
+    }
   } else if (compute_slopes) {
     # sanity check - contrast for slopes only makes sense when we have a "by" argument
     if (is.null(my_args$by)) {
@@ -159,6 +165,7 @@ get_marginalcontrasts <- function(
     info = list(
       contrast = my_args$contrast,
       predict = predict,
+      transform = transform,
       comparison = my_args$comparison,
       estimate = estimate,
       p_adjust = p_adjust,

R/table_footer.R

@@ -22,14 +22,23 @@
   if (isTRUE(info$joint_test)) {
     table_footer <- NULL
   } else {
-    table_footer <- paste0("\nVariable predicted: ", toString(insight::find_response(model)))
+    table_footer <- paste0(
+      "\nVariable predicted: ",
+      toString(insight::find_response(model))
+    )
   }
 
   # modulated predictors (focal terms) ---------------------------------------
 
   if (!is.null(by) && !isTRUE(info$joint_test)) {
     modulate_string <- switch(type, inequality = , contrasts = "contrasted", "modulated")
-    table_footer <- paste0(table_footer, "\nPredictors ", modulate_string, ": ", toString(by))
+    table_footer <- paste0(
+      table_footer,
+      "\nPredictors ",
+      modulate_string,
+      ": ",
+      toString(by)
+    )
   }
 
   # predictors controlled (non-focal terms) ----------------------------------
@@ -49,7 +58,11 @@
       # over the list, because we may have different types of data
       for (av in seq_along(adjusted_values)) {
         if (is.numeric(adjusted_values[[av]])) {
-          adjusted_for[av] <- sprintf("%s (%.2g)", adjusted_for[av], adjusted_values[[av]])
+          adjusted_for[av] <- sprintf(
+            "%s (%.2g)",
+            adjusted_for[av],
+            adjusted_values[[av]]
+          )
         } else if (identical(type, "predictions")) {
           adjusted_for[av] <- sprintf("%s (%s)", adjusted_for[av], adjusted_values[[av]])
         }
@@ -87,7 +100,12 @@
 
   # tell user about scale of predictions / contrasts -------------------------
 
-  result_type <- switch(type, inequality = "Differences", contrasts = "Contrasts", "Predictions")
+  result_type <- switch(
+    type,
+    inequality = "Differences",
+    contrasts = "Contrasts",
+    "Predictions"
+  )
 
   if (!is.null(predict) && isFALSE(model_info$is_linear)) {
     # exceptions
@@ -99,6 +117,12 @@
       `invlink(link)` = "response",
       predict
     )
+    ## TODO: simplification, we just mention it is transformed; we could check
+    ## model info and then handle different cases, like odds ratios or IRRs etc.
+    ## See `.guess_estimate_name()`
+    if (!is.null(transform)) {
+      predict <- "transformed"
+    }
     table_footer <- paste0(
       table_footer,
       "\n",
@@ -141,7 +165,11 @@
       hypothesis_labels <- unlist(
         lapply(parameter_names, function(i) {
           rows <- as.numeric(sub(".", "", i))
-          paste0(i, " = ", toString(paste0(info$focal_terms, " [", transposed_dg[, rows], "]")))
+          paste0(
+            i,
+            " = ",
+            toString(paste0(info$focal_terms, " [", transposed_dg[, rows], "]"))
+          )
         }),
         use.names = FALSE
       )