Use an internal version of glue (#21)

Use an internal version of glue in our functions
cedricbatailler · Jul 13, 2021 · 629e2d0 · 629e2d0
2 parents 776069e + d804e39
commit 629e2d0
Show file tree

Hide file tree

Showing 10 changed files with 112 additions and 94 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -30,6 +30,7 @@ export(mdt_moderated)
 export(mdt_simple)
 export(mdt_within)
 export(mdt_within_wide)
+importFrom(glue,glue)
 importFrom(magrittr,"%>%")
 importFrom(rlang,":=")
 importFrom(rlang,.data)

diff --git a/R/apastylr.R b/R/apastylr.R
@@ -26,7 +26,7 @@ apastylr.lm <- function(model, term) {
     broom::tidy(model)
 
   if(nrow(summary_statistics[summary_statistics$term == term, ]) == 0)
-     stop(glue::glue("Could not find \"{term}\" term in the model."),
+     stop(glue("Could not find \"{term}\" term in the model."),
           call. = FALSE)
 
   summary_statistics <- summary_statistics[summary_statistics$term == term, ]
@@ -41,18 +41,18 @@ apastylr.lm <- function(model, term) {
     summary_statistics$p.value[1]
 
   as.character(
-    glue::glue("t({df}) = {t}, p {p}",
-               p = ifelse(
-                 pvalue < .001,
-                 "< .001",
-                 sub(
-                   ".",
-                   "= ",
-                   format(round(summary_statistics$p.value, 3),
-                          nsmall = 3
-                   )
-                 )
-               )
+    glue("t({df}) = {t}, p {p}",
+         p = ifelse(
+           pvalue < .001,
+           "< .001",
+           sub(
+             ".",
+             "= ",
+             format(round(summary_statistics$p.value, 3),
+                    nsmall = 3
+             )
+           )
+         )
     )
   )
 

diff --git a/R/check_variables.R b/R/check_variables.R
@@ -44,7 +44,7 @@ please make sure it is intended as regression coefficients depends on the
 variables' coding:"
     )
     for (var in Var_n_check) {
-      message(glue::glue("* {var}"))
+      message(glue("* {var}"))
     }
   }
 }
diff --git a/R/compute_indirect_effect_for.R b/R/compute_indirect_effect_for.R
@@ -147,7 +147,7 @@ compute_indirect_effect_for.moderated_mediation <-
     indirect_sampling <- param_sampling[ , 1] * param_sampling[ , 2] 
 
     indirect_effect(
-      type          = glue::glue("Conditional simple mediation index (Mod = {Mod})"),
+      type          = glue("Conditional simple mediation index (Mod = {Mod})"),
       estimate      = a_estimate  * b_estimate,
       level         = level,
       times         = times,

diff --git a/R/mdt_moderated.R b/R/mdt_moderated.R
@@ -112,8 +112,8 @@ mdt_moderated.data.frame <- function(data, IV, DV, M, Mod) {
   DV_name    <- rlang::quo_name(DV_var)
   M_name     <- rlang::quo_name(M_var)
   Mod_name   <- rlang::quo_name(Mod_var)
-  IVMod_name <- glue::glue("{IV_name}:{Mod_name}")
-  MMod_name  <- glue::glue("{M_name}:{Mod_name}")
+  IVMod_name <- glue("{IV_name}:{Mod_name}")
+  MMod_name  <- glue("{M_name}:{Mod_name}")
 
   IV_data  <- data %>% dplyr::pull( !! IV_var )
   M_data   <- data %>% dplyr::pull( !! M_var )
@@ -123,41 +123,41 @@ mdt_moderated.data.frame <- function(data, IV, DV, M, Mod) {
 
   # type check ----------------------------------------------------------------
   if(!is.numeric(IV_data))
-    stop(glue::glue("Warning:
-                    IV ({IV_name}) must be numeric (see build_contrast() to
-                    convert a character vector to a contrast code)."))
+    stop(glue("Warning:
+               IV ({IV_name}) must be numeric (see build_contrast() to
+               convert a character vector to a contrast code)."))
 
   if(!is.numeric(M_data))
-    stop(glue::glue("Warning:
-                    Mediator ({M_name}) must be numeric."))
+    stop(glue("Warning:
+               Mediator ({M_name}) must be numeric."))
 
   if(!is.numeric(DV_data))
-    stop(glue::glue("Warning:
-                    DV ({DV_name}) must be numeric."))
+    stop(glue("Warning:
+               DV ({DV_name}) must be numeric."))
 
   if(!is.numeric(Mod_data))
-    stop(glue::glue("Warning:
-                    Moderator ({DV_name}) must be numeric."))
+    stop(glue("Warning:
+              Moderator ({DV_name}) must be numeric."))
 
   # building models -----------------------------------------------------------
   model1 <-
-    stats::as.formula(glue::glue("{DV} ~ {IV} * {Mod}",
-                                 IV  = IV_name,
-                                 DV  = DV_name,
-                                 Mod = Mod_name))
-
+    stats::as.formula(glue("{DV} ~ {IV} * {Mod}",
+                           IV  = IV_name,
+                           DV  = DV_name,
+                           Mod = Mod_name))
+  
   model2 <-
-    stats::as.formula(glue::glue("{M} ~ {IV} * {Mod}",
-                                 IV  = IV_name,
-                                 M   = M_name,
-                                 Mod = Mod_name))
-
+    stats::as.formula(glue("{M} ~ {IV} * {Mod}",
+                           IV  = IV_name,
+                           M   = M_name,
+                           Mod = Mod_name))
+  
   model3 <-
-    stats::as.formula(glue::glue("{DV} ~ ({IV} + {M}) * {Mod}",
-                                 DV  = DV_name,
-                                 IV  = IV_name,
-                                 M   = M_name,
-                                 Mod = Mod_name))
+    stats::as.formula(glue("{DV} ~ ({IV} + {M}) * {Mod}",
+                           DV  = DV_name,
+                           IV  = IV_name,
+                           M   = M_name,
+                           Mod = Mod_name))
 
   # model fitting and cleaning ------------------------------------------------
   js_models <-

diff --git a/R/mdt_simple.R b/R/mdt_simple.R
@@ -105,34 +105,34 @@ mdt_simple.data.frame <- function(data, IV, DV, M) {
 
   # type check ----------------------------------------------------------------
   if(!is.numeric(IV_data))
-    stop(glue::glue("Warning:
-                    IV ({IV_name}) must be numeric (see build_contrast() to
-                    convert a character vector to a contrast code)."))
+    stop(glue("Warning:
+               IV ({IV_name}) must be numeric (see build_contrast() to
+               convert a character vector to a contrast code)."))
 
   if(!is.numeric(M_data))
-    stop(glue::glue("Warning:
-                    Mediator ({M_name}) must be numeric."))
+    stop(glue("Warning:
+               Mediator ({M_name}) must be numeric."))
 
   if(!is.numeric(DV_data))
-    stop(glue::glue("Warning:
-                    DV ({DV_name}) must be numeric."))
+    stop(glue("Warning:
+               DV ({DV_name}) must be numeric."))
 
   # building models -----------------------------------------------------------
   model1 <-
-    stats::as.formula(glue::glue("{DV} ~ {IV}",
-                                 IV = IV_name,
-                                 DV = DV_name))
+    stats::as.formula(glue("{DV} ~ {IV}",
+                           IV = IV_name,
+                           DV = DV_name))
 
   model2 <-
-    stats::as.formula(glue::glue("{M} ~ {IV}",
-                                 IV = IV_name,
-                                 M  = M_name))
+    stats::as.formula(glue("{M} ~ {IV}",
+                           IV = IV_name,
+                           M  = M_name))
 
   model3 <-
-    stats::as.formula(glue::glue("{DV} ~ {IV} + {M}",
-                                 DV = DV_name,
-                                 IV = IV_name,
-                                 M  = M_name))
+    stats::as.formula(glue("{DV} ~ {IV} + {M}",
+                           DV = DV_name,
+                           IV = IV_name,
+                           M  = M_name))
 
   # models fitting and cleaning -----------------------------------------------
   js_models <-

diff --git a/R/mdt_within.R b/R/mdt_within.R
@@ -93,39 +93,39 @@ mdt_within.data.frame <- function(data, IV, DV, M, grouping, default_coding = TR
 
   # type check ----------------------------------------------------------------
   if(!is.character(IV_data))
-    stop(glue::glue("Warning:
-                    IV ({IV_name}) must be character."))
+    stop(glue("Warning:
+               IV ({IV_name}) must be character."))
 
   if(!is.numeric(DV_data))
-    stop(glue::glue("Warning:
-                    DV ({DV_name}) must be numeric."))
+    stop(glue("Warning:
+              DV ({DV_name}) must be numeric."))
 
   if(!is.numeric(M_data))
-    stop(glue::glue("Warning:
-                    Mediator ({M_name}) must be numeric."))
+    stop(glue("Warning:
+              Mediator ({M_name}) must be numeric."))
 
   # data wrangling ------------------------------------------------------------
   # naming
   IV_cond <- data %>% dplyr::pull( !! IV_var ) %>% unique()
 
   M_cond_1_name <-
-    as.character(glue::glue("{M_name}_mean_{IV_cond[[1]]}"))
+    as.character(glue("{M_name}_mean_{IV_cond[[1]]}"))
   M_cond_2_name <-
-    as.character(glue::glue("{M_name}_mean_{IV_cond[[2]]}"))
+    as.character(glue("{M_name}_mean_{IV_cond[[2]]}"))
 
   M_mean_name <-
-    as.character(glue::glue("{M_name}_mean"))
+    as.character(glue("{M_name}_mean"))
 
   DV_cond_1_name <-
-    as.character(glue::glue("{DV_name}_mean_{IV_cond[[1]]}"))
+    as.character(glue("{DV_name}_mean_{IV_cond[[1]]}"))
   DV_cond_2_name <-
-    as.character(glue::glue("{DV_name}_mean_{IV_cond[[2]]}"))
+    as.character(glue("{DV_name}_mean_{IV_cond[[2]]}"))
 
   # wrangling
   wrangling_formula <-
-    glue::glue("{grouping} ~ {IV}",
-               grouping = grouping_name,
-               IV       = IV_name) %>%
+    glue("{grouping} ~ {IV}",
+         grouping = grouping_name,
+         IV       = IV_name) %>%
     stats::as.formula()
 
   data_long <-
@@ -146,20 +146,20 @@ mdt_within.data.frame <- function(data, IV, DV, M, grouping, default_coding = TR
   # else, set B - A.
   if(DV_A_sup_B == default_coding) {
     DV_diff_name <-
-      as.character(glue::glue("DV_{IV_cond[[1]]}_{IV_cond[[2]]}"))
+      as.character(glue("DV_{IV_cond[[1]]}_{IV_cond[[2]]}"))
     M_diff_name <-
-      as.character(glue::glue("IV_{IV_cond[[1]]}_{IV_cond[[2]]}"))
+      as.character(glue("IV_{IV_cond[[1]]}_{IV_cond[[2]]}"))
 
     data_long <-
       data_long %>%
       dplyr::mutate( !! sym(DV_diff_name) := !! sym(DV_cond_1_name) - !! sym(DV_cond_2_name),
                      !! sym(M_diff_name)  := !! sym(M_cond_1_name)  - !! sym(M_cond_2_name))
   } else {
     DV_diff_name <-
-      as.character(glue::glue("DV_{IV_cond[[2]]}_{IV_cond[[1]]}"))
+      as.character(glue("DV_{IV_cond[[2]]}_{IV_cond[[1]]}"))
 
     M_diff_name <-
-      as.character(glue::glue("M_{IV_cond[[2]]}_{IV_cond[[1]]}"))
+      as.character(glue("M_{IV_cond[[2]]}_{IV_cond[[1]]}"))
 
     data_long <-
       data_long %>%
@@ -174,18 +174,18 @@ mdt_within.data.frame <- function(data, IV, DV, M, grouping, default_coding = TR
 
   # bulding models ------------------------------------------------------------
   model1 <-
-    stats::as.formula(glue::glue("{DV} ~ 1",
-                                 DV = DV_diff_name))
-
+    stats::as.formula(glue("{DV} ~ 1",
+                           DV = DV_diff_name))
+  
   model2 <-
-    stats::as.formula(glue::glue("{M}  ~ 1",
-                                 M = M_diff_name))
-
+    stats::as.formula(glue("{M}  ~ 1",
+                           M = M_diff_name))
+  
   model3 <-
-    stats::as.formula(glue::glue("{DV}  ~ 1 + {M} + {M_mean}",
-                                 DV     = DV_diff_name,
-                                 M      = M_diff_name,
-                                 M_mean = M_mean_name))
+    stats::as.formula(glue("{DV}  ~ 1 + {M} + {M_mean}",
+                           DV     = DV_diff_name,
+                           M      = M_diff_name,
+                           M_mean = M_mean_name))
 
   # model fitting and cleaning ------------------------------------------------
   js_models <-
@@ -204,10 +204,10 @@ mdt_within.data.frame <- function(data, IV, DV, M, grouping, default_coding = TR
   # bulding mediation model object --------------------------------------------
   mediation_model(
     type      = "within-participant_mediation",
-    params    = list("IV" = glue::glue("{IV_name} (difference: {score})",
-                                       score = ifelse(DV_A_sup_B == default_coding,
-                                                      paste0(IV_cond[[1]], " - ", IV_cond[[2]]),
-                                                      paste0(IV_cond[[2]], " - ", IV_cond[[1]]))),
+    params    = list("IV" = glue("{IV_name} (difference: {score})",
+                                 score = ifelse(DV_A_sup_B == default_coding,
+                                                paste0(IV_cond[[1]], " - ", IV_cond[[2]]),
+                                                paste0(IV_cond[[2]], " - ", IV_cond[[1]]))),
                      "DV" = DV_name,
                      "M"  = M_name),
     paths     = paths,

diff --git a/R/mdt_within_wide.R b/R/mdt_within_wide.R
@@ -144,8 +144,8 @@ mdt_within_wide.data.frame <- function(data, DV_A, DV_B, M_A, M_B) {
   # bulding mediation model object --------------------------------------------
   mediation_model(
     type      = "within-participant mediation",
-    params    = list("DV difference" = glue::glue("{DV_A_name} - {DV_B_name}"),
-                     "M difference"  = glue::glue("{M_A_name} - {M_B_name}")),
+    params    = list("DV difference" = glue("{DV_A_name} - {DV_B_name}"),
+                     "M difference"  = glue("{M_A_name} - {M_B_name}")),
     paths     = paths,
     js_models = js_models,
     data      = data,

diff --git a/R/mediation_model_print.R b/R/mediation_model_print.R
@@ -18,14 +18,14 @@ print.mediation_model <- function(x, digits = 3, ...) {
   models <- x %>% purrr::pluck("js_models")
 
   # summary -------------------------------------------------------------------
-  cat(glue::glue("Test of mediation ({type})\n\n"))
+  cat(glue("Test of mediation ({type})\n\n"))
   cat("==============================================\n")
 
   cat("\nVariables:\n\n")
 
   purrr::map2(params,
               names(params),
-              ~ cat(glue::glue("- {.y}: {.x} \n\n")))
+              ~ cat(glue("- {.y}: {.x} \n\n")))
 
   check_variables(x)
 

diff --git a/R/utils-glue.R b/R/utils-glue.R
@@ -0,0 +1,17 @@
+#' Format and interpolate a string
+#' 
+#' @description 
+#' 
+#' * [`glue::glue`] formats and interpolates a string. Expressions enclosed by
+#'   braces will be evaluated as R code. Long strings are broken by line and
+#'   concatenated together. Leading whitespace and blank lines from the first
+#'   and ast lines are automatically trimmed.
+#' 
+#' @name glue
+
+#' @keywords internal
+#' @noRd
+#'
+#' @importFrom glue glue
+#' @aliases glue
+NULL