Merge pull request #298 from easystats/show_intercept

Update intercept detection and prior plotting

R/plot.bayesfactor_parameters.R

@@ -32,9 +32,9 @@ plot.see_bayesfactor_parameters <- function(x,
   hypothesis <- attr(x, "hypothesis")
 
   # if we have intercept-only models, keep at least the intercept
-  intercepts_points <- which(.in_intercepts(d_points$ind))
+  intercepts_points <- which(.is_intercept(d_points$ind))
   if (length(intercepts_points) && (nrow(d_points) > length(intercepts_points)) && !show_intercept) {
-    intercepts_data <- which(.in_intercepts(plot_data$ind))
+    intercepts_data <- which(.is_intercept(plot_data$ind))
     plot_data <- plot_data[-intercepts_data, ]
     d_points <- d_points[-intercepts_points, ]
   }

R/plot.compare_parameters.R

@@ -77,7 +77,7 @@ plot.see_compare_parameters <- function(x,
 
 
   if (!show_intercept) {
-    x <- x[!.in_intercepts(x$Parameter), ]
+    x <- x[!.is_intercept(x$Parameter), ]
   }
 
   if (isTRUE(sort) || (!is.null(sort) && sort == "ascending")) {

R/plot.equivalence_test.R

@@ -48,13 +48,13 @@ plot.see_equivalence_test <- function(x,
   }
 
   # if we have intercept-only models, keep at least the intercept
-  intercepts <- which(.in_intercepts(x$Parameter))
+  intercepts <- which(.is_intercept(x$Parameter))
   if (length(intercepts) && nrow(x) > length(intercepts) && !show_intercept) {
     x <- x[-intercepts, ]
   }
 
   cp <- insight::clean_parameters(model)
-  intercepts <- which(.in_intercepts(cp$Parameter))
+  intercepts <- which(.is_intercept(cp$Parameter))
   if (length(intercepts) && nrow(x) > length(intercepts) && !show_intercept) {
     cp <- cp[-intercepts, ]
   }
@@ -380,7 +380,7 @@ plot.see_equivalence_test_lm <- function(x,
   }
 
   # if we have intercept-only models, keep at least the intercept
-  intercepts <- which(.in_intercepts(x$Parameter))
+  intercepts <- which(.is_intercept(x$Parameter))
   if (length(intercepts) && nrow(x) > length(intercepts) && !show_intercept) {
     x <- x[-intercepts, ]
   }

R/plot.estimate_density.R

@@ -131,6 +131,9 @@ plot.see_estimate_density <- function(x,
     n_columns <- NULL
   }
 
+  # get parameter names for filtering
+  params <- unique(x$y)
+
   # get labels
   labels <- .clean_parameter_names(x$Parameter, grid = !is.null(n_columns))
 
@@ -152,6 +155,7 @@ plot.see_estimate_density <- function(x,
       p <- p +
         .add_prior_layer_ridgeline(
           model,
+          parameter = params,
           show_intercept = show_intercept,
           priors_alpha = priors_alpha,
           show_ridge_line = FALSE

R/plot.hdi.R

@@ -108,7 +108,7 @@ data_plot.bayestestR_eti <- data_plot.hdi
   groups <- unique(dataplot$y)
   if (!show_intercept) {
     dataplot <- .remove_intercept(dataplot, column = "y", show_intercept)
-    groups <- unique(setdiff(groups, .intercepts()))
+    groups <- unique(setdiff(groups, .intercept_names))
   }
 
   if (length(groups) == 1) {

R/plot.p_direction.R

@@ -95,7 +95,7 @@ data_plot.p_direction <- function(x, data = NULL, show_intercept = FALSE, ...) {
   groups <- unique(dataplot$y)
   if (!show_intercept) {
     dataplot <- .remove_intercept(dataplot, column = "y", show_intercept)
-    groups <- unique(setdiff(groups, .intercepts()))
+    groups <- unique(setdiff(groups, .intercept_names))
   }
 
   if (length(groups) == 1) {
@@ -180,6 +180,9 @@ plot.see_p_direction <- function(x,
     n_columns <- NULL
   }
 
+  # get parameter names for filtering
+  params <- unique(x$y)
+
   # get labels
   labels <- .clean_parameter_names(x$y, grid = !is.null(n_columns))
 
@@ -203,6 +206,7 @@ plot.see_p_direction <- function(x,
   if (priors) {
     p <- p + .add_prior_layer_ridgeline(
       model,
+      parameter = params,
       show_intercept = show_intercept,
       priors_alpha = priors_alpha
     )

R/plot.p_significance.R

@@ -103,7 +103,7 @@ data_plot.p_significance <- function(x,
   groups <- unique(dataplot$y)
   if (!show_intercept) {
     dataplot <- .remove_intercept(dataplot, column = "y", show_intercept)
-    groups <- unique(setdiff(groups, .intercepts()))
+    groups <- unique(setdiff(groups, .intercept_names))
   }
 
   if (length(groups) == 1) {
@@ -192,6 +192,9 @@ plot.see_p_significance <- function(x,
     n_columns <- NULL
   }
 
+  # get parameter names for filtering
+  params <- unique(x$y)
+
   # get labels
   labels <- .clean_parameter_names(x$y, grid = !is.null(n_columns))
 
@@ -216,6 +219,7 @@ plot.see_p_significance <- function(x,
     p <- p +
       .add_prior_layer_ridgeline(
         model,
+        parameter = params,
         show_intercept = show_intercept,
         priors_alpha = priors_alpha
       ) +

R/plot.parameters_model.R

@@ -306,10 +306,10 @@ plot.see_parameters_model <- function(x,
   }
 
 
-  if (!show_intercept && length(.in_intercepts(x$Parameter)) > 0L) {
-    x <- x[!.in_intercepts(x$Parameter), ]
+  if (!show_intercept && length(.is_intercept(x$Parameter)) > 0L) {
+    x <- x[!.is_intercept(x$Parameter), ]
     if (show_density && (is_bayesian || is_bootstrap)) {
-      data <- data[!.in_intercepts(data$Parameter), ]
+      data <- data[!.is_intercept(data$Parameter), ]
       density_layer$data <- data
     }
   }

R/plot.point_estimates.R

@@ -132,7 +132,7 @@ plot.see_point_estimate <- function(x,
       x_lab <- "Parameter Value"
     }
 
-    if (!show_intercept && .has_intercept(x_lab)) {
+    if (!show_intercept && .is_intercept(x_lab)) {
       return(NULL)
     }
 

R/plot.rope.R

@@ -42,7 +42,7 @@ data_plot.rope <- function(x, data = NULL, show_intercept = FALSE, ...) {
   groups <- unique(dataplot$y)
   if (!show_intercept) {
     dataplot <- .remove_intercept(dataplot, column = "y", show_intercept = show_intercept)
-    groups <- unique(setdiff(groups, .intercepts()))
+    groups <- unique(setdiff(groups, .intercept_names))
   }
 
   if (length(groups) == 1) {

R/plot.si.R

@@ -32,9 +32,9 @@ plot.see_si <- function(x,
   x$ind <- x$Parameter
 
   # if we have intercept-only models, keep at least the intercept
-  intercepts_data <- which(.in_intercepts(plot_data$ind))
+  intercepts_data <- which(.is_intercept(plot_data$ind))
   if (length(intercepts_data) && (nrow(plot_data) > length(intercepts_data)) && !show_intercept) {
-    intercepts_si <- which(.in_intercepts(x$ind))
+    intercepts_si <- which(.is_intercept(x$ind))
     x <- x[-intercepts_si, ]
     plot_data <- plot_data[-intercepts_data, ]
   }

R/utils.R

@@ -113,7 +113,7 @@
 
 
 
-.intercepts <- function() {
+.intercept_names <-
   c(
     "(intercept)_zi",
     "intercept (zero-inflated)",
@@ -123,21 +123,16 @@
     "b_intercept",
     "b_zi_intercept"
   )
-}
 
 
-.has_intercept <- function(x) {
+.is_intercept <- function(x) {
   x <- tolower(x)
-  x %in% .intercepts() | !is.na(x) & startsWith(x, "intercept")
+  x %in% .intercept_names | grepl("(?i)intercept[^a-zA-Z]", x)
 }
 
-
-.in_intercepts <- .has_intercept
-
-
 .remove_intercept <- function(x, column = "Parameter", show_intercept = FALSE) {
   if (!show_intercept) {
-    remove <- which(.in_intercepts(x[[column]]))
+    remove <- which(.is_intercept(x[[column]]))
     if (length(remove)) x <- x[-remove, ]
   }
   x