Merge pull request #37 from egouldo/weight_investigation

add funs and document for weight investigation

R/plot_model_means_box_cox_cat.R

@@ -0,0 +1,84 @@
+#' @title plot_model_means_box_cox_cat
+#' @description Plot model means for box-cox transformed deviation scores as a function of categorical ratings
+#' @param dat Data for plotting
+#' @param variable Categorical predictor variable to plot
+#' @param predictor_means A tibble containing the means and confidence intervals of the predictor variable
+#' @param new_order A character vector of the new order of the levels of the categorical predictor
+#' @param title A character vector of the plot title
+#' @param lambda A length 1 numeric vector of the lambda value used in the box-cox transformation
+#' @param back_transform A logical indicating whether to back-transform the box-cox transformed data
+#' @return A ggplot object
+#' @export
+#' @import ggplot2
+#' @import dplyr
+#' @import see
+#' @importFrom EnvStats stat_n_text
+#' @importFrom forcats fct_relevel
+#' @importFrom sae bxcx
+plot_model_means_box_cox_cat <- function(dat, 
+                                         variable, 
+                                         predictor_means, 
+                                         new_order, 
+                                         title, 
+                                         lambda,
+                                         back_transform = FALSE) {
+  dat <- mutate(dat, 
+                "{{variable}}" := # 
+                  fct_relevel(.f = {{variable}}, 
+                              new_order)
+  )
+
+  if(back_transform == TRUE){
+    dat <- dat %>% 
+      mutate(box_cox_abs_deviation_score_estimate = 
+               sae::bxcx(unique(lambda),
+                         x = box_cox_abs_deviation_score_estimate, InverseQ = TRUE))
+
+    predictor_means <- predictor_means %>% 
+      as_tibble() %>% 
+      mutate(lambda = lambda %>% unique()) %>%  
+      mutate(across(.cols = -PublishableAsIs,
+                    ~ sae::bxcx(unique(lambda),x = .x, InverseQ = TRUE)))
+  }
+
+  p <- ggplot(dat, aes(x = {{variable}},
+                       y = box_cox_abs_deviation_score_estimate)) +
+    # Add base dat
+    geom_violin(aes(fill = {{variable}}),
+                trim = TRUE, 
+                # scale = "count", #TODO consider toggle on/off?
+                colour = "white") +
+    see::geom_jitter2(width = 0.05, alpha = 0.5) +
+    # Add pointrange and line from means
+    geom_line(dat = predictor_means, aes(y = Mean, group = 1), linewidth = 1) +
+    geom_pointrange(
+      dat = predictor_means,
+      aes(y = Mean, ymin = CI_low, ymax = CI_high),
+      size = 1,
+      color = "grey",
+      alpha = 0.5
+    ) +
+    # Improve colors
+    see::scale_fill_material_d(discrete = TRUE, 
+                               name = "",
+                               palette = "ice",
+                               labels = pull(dat, {{variable}}) %>% 
+                                 levels() %>% 
+                                 capwords(),
+                               reverse = TRUE) +
+    EnvStats::stat_n_text() +
+    see::theme_modern() +
+    theme(axis.text.x = element_text(angle = 90)) #+
+  # ggtitle(label = title)
+
+  if(back_transform == TRUE){
+    p <- p + 
+      labs(x = "Categorical Peer Review Rating", 
+           y = "Absolute Deviation from\n Meta-Anaytic Mean Zr") 
+  } else {
+    p <- p + labs(x = "Categorical Peer Review Rating", 
+                  y = "Deviation from\nMeta-Analytic Mean Effect Size") 
+  }
+
+  return(p)
+}

R/plot_model_means_orchard.R

@@ -0,0 +1,47 @@
+#' @title plot_model_means_orchard
+#' @description Plot the means of a model with a predictor variable
+#' @param dat A tibble with the data to plot
+#' @param variable A character string of the predictor variable to plot
+#' @param predictor_means A tibble with the means of the model
+#' @param new_order A character vector of the new order of the `variable`
+#' @param title A character string of the plot title
+#' @return A ggplot object
+#' @export
+#' @import ggplot2
+#' @import ggbeeswarm
+#' @import dplyr
+#' @import see
+#' @importFrom forcats fct_relevel
+plot_model_means_orchard <- function(dat, 
+                                     variable, 
+                                     predictor_means, 
+                                     new_order, 
+                                     title){
+
+  dat <- dat %>% 
+    rename(weights = `(weights)`) %>% 
+    mutate("{{variable}}" := # 
+             fct_relevel(.f = {{variable}}, 
+                         new_order),
+           weights = as.numeric(weights)
+    )
+
+  ggplot() +
+    ggbeeswarm::geom_quasirandom(data = dat, 
+                                 mapping = ggplot2::aes(y = box_cox_abs_deviation_score_estimate, 
+                                                        x = {{variable}}, 
+                                                        size = weights, 
+                                                        colour = {{variable}}),
+                                 alpha = 0.7) +
+    geom_pointrange(
+      dat = predictor_means,
+      aes(x = {{variable}}, y = Mean, ymin = CI_low, ymax = CI_high, color = {{variable}}),
+      size = 1,
+      alpha = 1
+    ) +
+    see::theme_modern() +
+    theme(axis.text.x = element_text(angle = 90)) +
+    ggtitle(label = title)
+
+
+}