checking rest soft depenencies.

insightsengineering · Jun 28, 2024 · a94b5fd · a94b5fd
1 parent 5682593
commit a94b5fd
Show file tree

Hide file tree

Showing 5 changed files with 86 additions and 96 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -30,11 +30,17 @@ Depends:
     teal (>= 0.15.1),
     teal.transform (>= 0.5.0)
 Imports:
+    broom (>= 0.7.10),
     checkmate (>= 2.1.0),
+    colourpicker,
     dplyr (>= 1.0.5),
     DT (>= 0.13),
     forcats (>= 1.0.0),
     grid,
+    ggExtra,
+    goftest,
+    ggrepel,
+    lattice (>= 0.18-4),
     logger (>= 0.3.0),
     scales,
     shinyjs,
@@ -54,18 +60,12 @@ Imports:
     tools,
     utils
 Suggests:
-    broom (>= 0.7.10),
-    colourpicker,
-    ggExtra,
     ggpmisc (>= 0.4.3),
     ggpp,
-    ggrepel,
-    goftest,
     gridExtra,
     htmlwidgets,
     jsonlite,
     knitr (>= 1.42),
-    lattice (>= 0.18-4),
     MASS,
     nestcolor (>= 0.1.0),
     pkgload,

diff --git a/R/tm_g_distribution.R b/R/tm_g_distribution.R
@@ -121,16 +121,6 @@ tm_g_distribution <- function(label = "Distribution Module",
                               post_output = NULL) {
   message("Initializing tm_g_distribution")
 
-  # Requires Suggested packages
-  extra_packages <- c("ggpmisc", "ggpp", "goftest", "MASS", "broom")
-  missing_packages <- Filter(function(x) !requireNamespace(x, quietly = TRUE), extra_packages)
-  if (length(missing_packages) > 0L) {
-    stop(sprintf(
-      "Cannot load package(s): %s.\nInstall or restart your session.",
-      toString(missing_packages)
-    ))
-  }
-
   # Normalize the parameters
   if (inherits(dist_var, "data_extract_spec")) dist_var <- list(dist_var)
   if (inherits(strata_var, "data_extract_spec")) strata_var <- list(strata_var)
@@ -520,7 +510,11 @@ srv_distribution <- function(id,
                 return(stats::setNames(range(x, na.rm = TRUE), c("min", "max")))
               }
               tryCatch(
-                MASS::fitdistr(x, densfun = dist)$estimate,
+                if (requireNamespace("MASS", quietly = TRUE)) {
+                  MASS::fitdistr(x, densfun = dist)$estimate
+                } else {
+                  stop()
+                } ,
                 error = function(e) c(param1 = NA_real_, param2 = NA_real_)
               )
             }
@@ -836,14 +830,16 @@ srv_distribution <- function(id,
           datas <- quote(data.frame(x = 0.7, y = 1, tb = I(list(df_params = df_params))))
           label <- quote(tb)
 
-          plot_call <- substitute(
-            expr = plot_call + ggpp::geom_table_npc(
-              data = data,
-              aes(npcx = x, npcy = y, label = label),
-              hjust = 0, vjust = 1, size = 4
-            ),
-            env = list(plot_call = plot_call, data = datas, label = label)
-          )
+          if (requireNamespace("ggpp", quietly = TRUE)) {
+            plot_call <- substitute(
+              expr = plot_call + ggpp::geom_table_npc(
+                data = data,
+                aes(npcx = x, npcy = y, label = label),
+                hjust = 0, vjust = 1, size = 4
+              ),
+              env = list(plot_call = plot_call, data = datas, label = label)
+            )
+          }
         }
 
         if (
@@ -983,21 +979,23 @@ srv_distribution <- function(id,
           datas <- quote(data.frame(x = 0.7, y = 1, tb = I(list(df_params = df_params))))
           label <- quote(tb)
 
-          plot_call <- substitute(
-            expr = plot_call +
-              ggpp::geom_table_npc(
-                data = data,
-                aes(npcx = x, npcy = y, label = label),
-                hjust = 0,
-                vjust = 1,
-                size = 4
-              ),
-            env = list(
-              plot_call = plot_call,
-              data = datas,
-              label = label
+          if (requireNamespace("ggpp", quietly = TRUE)) {
+            plot_call <- substitute(
+              expr = plot_call +
+                ggpp::geom_table_npc(
+                  data = data,
+                  aes(npcx = x, npcy = y, label = label),
+                  hjust = 0,
+                  vjust = 1,
+                  size = 4
+                ),
+              env = list(
+                plot_call = plot_call,
+                data = datas,
+                label = label
+              )
             )
-          )
+          }
         }
 
         if (isTRUE(input$qq_line)) {

diff --git a/R/tm_g_scatterplot.R b/R/tm_g_scatterplot.R
@@ -229,16 +229,6 @@ tm_g_scatterplot <- function(label = "Scatterplot",
                              ggplot2_args = teal.widgets::ggplot2_args()) {
   message("Initializing tm_g_scatterplot")
 
-  # Requires Suggested packages
-  extra_packages <- c("ggpmisc", "ggExtra", "colourpicker")
-  missing_packages <- Filter(function(x) !requireNamespace(x, quietly = TRUE), extra_packages)
-  if (length(missing_packages) > 0L) {
-    stop(sprintf(
-      "Cannot load package(s): %s.\nInstall or restart your session.",
-      toString(missing_packages)
-    ))
-  }
-
   # Normalize the parameters
   if (inherits(x, "data_extract_spec")) x <- list(x)
   if (inherits(y, "data_extract_spec")) y <- list(y)
@@ -827,28 +817,31 @@ srv_g_scatterplot <- function(id,
           ),
           if (sum(show_form, show_r2, show_count) > 1) ", sep = '*\", \"*'))" else ")"
         )
-        label_geom <- substitute(
-          expr = ggpmisc::stat_poly_eq(
-            mapping = aes_label,
-            formula = rhs_formula,
-            parse = TRUE,
-            label.x = pos,
-            size = label_size
-          ),
-          env = list(
-            rhs_formula = rhs_formula,
-            pos = pos,
-            aes_label = str2lang(aes_label),
-            label_size = label_size
+
+        if (requireNamespace("ggpmisc", quietly = TRUE)) {
+          label_geom <- substitute(
+            expr = ggpmisc::stat_poly_eq(
+              mapping = aes_label,
+              formula = rhs_formula,
+              parse = TRUE,
+              label.x = pos,
+              size = label_size
+            ),
+            env = list(
+              rhs_formula = rhs_formula,
+              pos = pos,
+              aes_label = str2lang(aes_label),
+              label_size = label_size
+            )
           )
-        )
-        substitute(
-          expr = plot_call + label_geom,
-          env = list(
-            plot_call = plot_call,
-            label_geom = label_geom
+          substitute(
+            expr = plot_call + label_geom,
+            env = list(
+              plot_call = plot_call,
+              label_geom = label_geom
+            )
           )
-        )
+        }
       }
 
       if (trend_line_is_applicable()) {
@@ -949,20 +942,23 @@ srv_g_scatterplot <- function(id,
 
 
       if (add_density) {
-        plot_call <- substitute(
-          expr = ggExtra::ggMarginal(
-            plot_call + labs + ggthemes + themes,
-            type = "density",
-            groupColour = group_colour
-          ),
-          env = list(
-            plot_call = plot_call,
-            group_colour = if (length(color_by_var) > 0) TRUE else FALSE,
-            labs = parsed_ggplot2_args$labs,
-            ggthemes = parsed_ggplot2_args$ggtheme,
-            themes = parsed_ggplot2_args$theme
+        if (requireNamespace("ggExtra", quietly = TRUE)) {
+          plot_call <- substitute(
+            expr = ggExtra::ggMarginal(
+              plot_call + labs + ggthemes + themes,
+              type = "density",
+              groupColour = group_colour
+            ),
+            env = list(
+              plot_call = plot_call,
+              group_colour = if (length(color_by_var) > 0) TRUE else FALSE,
+              labs = parsed_ggplot2_args$labs,
+              ggthemes = parsed_ggplot2_args$ggtheme,
+              themes = parsed_ggplot2_args$theme
+            )
           )
-        )
+        }
+
       } else {
         plot_call <- substitute(
           expr = plot_call +

diff --git a/R/tm_g_scatterplotmatrix.R b/R/tm_g_scatterplotmatrix.R
@@ -164,11 +164,6 @@ tm_g_scatterplotmatrix <- function(label = "Scatterplot Matrix",
                                    post_output = NULL) {
   message("Initializing tm_g_scatterplotmatrix")
 
-  # Requires Suggested packages
-  if (!requireNamespace("lattice", quietly = TRUE)) {
-    stop("Cannot load lattice - please install the package or restart your session.")
-  }
-
   # Normalize the parameters
   if (inherits(variables, "data_extract_spec")) variables <- list(variables)
 

diff --git a/R/tm_missing_data.R b/R/tm_missing_data.R
@@ -91,14 +91,6 @@ tm_missing_data <- function(label = "Missing data",
                             post_output = NULL) {
   message("Initializing tm_missing_data")
 
-  # Requires Suggested packages
-  if (!requireNamespace("gridExtra", quietly = TRUE)) {
-    stop("Cannot load gridExtra - please install the package or restart your session.")
-  }
-  if (!requireNamespace("rlang", quietly = TRUE)) {
-    stop("Cannot load rlang - please install the package or restart your session.")
-  }
-
   # Normalize the parameters
   if (inherits(ggplot2_args, "ggplot2_args")) ggplot2_args <- list(default = ggplot2_args)
 
@@ -1158,14 +1150,23 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par
               dplyr::summarise_all(anyNA) %>%
               dplyr::ungroup()
 
+            create_hash_base <- function(x) {
+              if(requireNamespace("rlang", quietly = TRUE)) {
+                rlang::hash(x)
+              } else {
+                raw_serialized <- serialize(x, NULL)
+                paste(as.integer(raw_serialized), collapse = "")
+              }
+            }
+
             # order subjects by decreasing number of missing and then by
             # missingness pattern (defined using sha1)
             order_subjects <- summary_plot_patients %>%
               dplyr::select(-"id", -dplyr::all_of(parent_keys)) %>%
               dplyr::transmute(
                 id = dplyr::row_number(),
                 number_NA = apply(., 1, sum),
-                sha = apply(., 1, rlang::hash)
+                sha = apply(., 1, create_hash_base)
               ) %>%
               dplyr::arrange(dplyr::desc(number_NA), sha) %>%
               getElement(name = "id")