Adds missing assertions and reorganizes them

R/tm_a_pca.R

@@ -110,14 +110,38 @@ tm_a_pca <- function(label = "Principal Component Analysis",
                      pre_output = NULL,
                      post_output = NULL) {
   logger::log_info("Initializing tm_a_pca")
+
+  # Normalizing data types
   if (inherits(dat, "data_extract_spec")) dat <- list(dat)
   if (inherits(ggplot2_args, "ggplot2_args")) ggplot2_args <- list(default = ggplot2_args)
 
+  # Start of assertions
   checkmate::assert_string(label)
   checkmate::assert_list(dat, types = "data_extract_spec")
+
+  checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
+  checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
+  checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
+  checkmate::assert_numeric(
+    plot_width[1],
+    lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
+  )
+
   ggtheme <- match.arg(ggtheme)
+
+  plot_choices <- c("Elbow plot", "Circle plot", "Biplot", "Eigenvector plot")
+  checkmate::assert_list(ggplot2_args, types = "ggplot2_args")
+  checkmate::assert_subset(names(ggplot2_args), c("default", plot_choices))
+
   checkmate::assert_flag(rotate_xaxis_labels)
 
+  if (length(font_size) == 1) {
+    checkmate::assert_numeric(font_size, any.missing = FALSE, finite = TRUE, lower = 8, upper = 20)
+  } else {
+    checkmate::assert_numeric(font_size, len = 3, any.missing = FALSE, finite = TRUE, lower = 8, upper = 20)
+    checkmate::assert_numeric(font_size[1], lower = font_size[2], upper = font_size[3], .var.name = "font_size")
+  }
+
   if (length(alpha) == 1) {
     checkmate::assert_numeric(alpha, any.missing = FALSE, finite = TRUE, lower = 0, upper = 1)
   } else {
@@ -132,25 +156,11 @@ tm_a_pca <- function(label = "Principal Component Analysis",
     checkmate::assert_numeric(size[1], lower = size[2], upper = size[3], .var.name = "size")
   }
 
-  if (length(font_size) == 1) {
-    checkmate::assert_numeric(font_size, any.missing = FALSE, finite = TRUE, lower = 8, upper = 20)
-  } else {
-    checkmate::assert_numeric(font_size, len = 3, any.missing = FALSE, finite = TRUE, lower = 8, upper = 20)
-    checkmate::assert_numeric(font_size[1], lower = font_size[2], upper = font_size[3], .var.name = "font_size")
-  }
-
-  checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
-  checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
-  checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
-  checkmate::assert_numeric(
-    plot_width[1],
-    lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
-  )
-
-  plot_choices <- c("Elbow plot", "Circle plot", "Biplot", "Eigenvector plot")
-  checkmate::assert_list(ggplot2_args, types = "ggplot2_args")
-  checkmate::assert_subset(names(ggplot2_args), c("default", plot_choices))
+  checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
+  checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
+  # End of assertions
 
+  # Make UI args
   args <- as.list(environment())
 
   data_extract_list <- list(dat = dat)

R/tm_a_regression.R

@@ -143,33 +143,56 @@ tm_a_regression <- function(label = "Regression Analysis",
                             default_plot_type = 1,
                             default_outlier_label = "USUBJID") {
   logger::log_info("Initializing tm_a_regression")
+
+  # Normalizing data types
   if (inherits(regressor, "data_extract_spec")) regressor <- list(regressor)
   if (inherits(response, "data_extract_spec")) response <- list(response)
   if (inherits(ggplot2_args, "ggplot2_args")) ggplot2_args <- list(default = ggplot2_args)
 
+  # Start of assertions
   checkmate::assert_string(label)
+  checkmate::assert_list(regressor, types = "data_extract_spec")
   checkmate::assert_list(response, types = "data_extract_spec")
-  if (!all(vapply(response, function(x) !(x$select$multiple), logical(1)))) {
-    stop("'response' should not allow multiple selection")
+  assert_single_selection(response)
+
+  checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
+  checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
+  checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
+  checkmate::assert_numeric(
+    plot_width[1],
+    lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
+  )
+
+  if (length(alpha) == 1) {
+    checkmate::assert_numeric(alpha, any.missing = FALSE, finite = TRUE)
+  } else {
+    checkmate::assert_numeric(alpha, len = 3, any.missing = FALSE, finite = TRUE)
+    checkmate::assert_numeric(alpha[1], lower = alpha[2], upper = alpha[3], .var.name = "alpha")
   }
-  checkmate::assert_list(regressor, types = "data_extract_spec")
+
+  if (length(size) == 1) {
+    checkmate::assert_numeric(size, any.missing = FALSE, finite = TRUE)
+  } else {
+    checkmate::assert_numeric(size, len = 3, any.missing = FALSE, finite = TRUE)
+    checkmate::assert_numeric(size[1], lower = size[2], upper = size[3], .var.name = "size")
+  }
+
   ggtheme <- match.arg(ggtheme)
-  checkmate::assert_string(default_outlier_label)
+
   plot_choices <- c(
     "Response vs Regressor", "Residuals vs Fitted", "Normal Q-Q", "Scale-Location",
     "Cook's distance", "Residuals vs Leverage", "Cook's dist vs Leverage"
   )
   checkmate::assert_list(ggplot2_args, types = "ggplot2_args")
   checkmate::assert_subset(names(ggplot2_args), c("default", plot_choices))
-  checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
-  checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
-  checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
-  checkmate::assert_numeric(
-    plot_width[1],
-    lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
-  )
 
-  # Send ui args
+  checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
+  checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
+  checkmate::assert_choice(default_plot_type, seq.int(1, length(plot_choices)))
+  checkmate::assert_string(default_outlier_label)
+  # End of assertions
+
+  # Make UI args
   args <- as.list(environment())
   args[["plot_choices"]] <- plot_choices
   data_extract_list <- list(

R/tm_data_table.R

@@ -89,7 +89,10 @@ tm_data_table <- function(label = "Data Table",
                           pre_output = NULL,
                           post_output = NULL) {
   logger::log_info("Initializing tm_data_table")
+
+  # Start of assertions
   checkmate::assert_string(label)
+
   checkmate::assert_list(variables_selected, min.len = 0, types = "character", names = "named")
   if (length(variables_selected) > 0) {
     lapply(seq_along(variables_selected), function(i) {
@@ -99,14 +102,17 @@ tm_data_table <- function(label = "Data Table",
       }
     })
   }
+
   checkmate::assert_character(datasets_selected, min.len = 0, min.chars = 1)
-  checkmate::assert_list(dt_options, names = "named")
   checkmate::assert(
     checkmate::check_list(dt_args, len = 0),
     checkmate::check_subset(names(dt_args), choices = names(formals(DT::datatable)))
   )
-
+  checkmate::assert_list(dt_options, names = "named")
   checkmate::assert_flag(server_rendering)
+  checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
+  checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
+  # End of assertions
 
   module(
     label,

R/tm_file_viewer.R

@@ -39,25 +39,24 @@
 tm_file_viewer <- function(label = "File Viewer Module",
                            input_path = list("Current Working Directory" = ".")) {
   logger::log_info("Initializing tm_file_viewer")
-  if (length(label) == 0 || identical(label, "")) {
-    label <- " "
-  }
-  if (length(input_path) == 0 || identical(input_path, "")) {
-    input_path <- list()
-  }
 
+  # Normalize the parameters
+  if (length(label) == 0 || identical(label, "")) label <- " "
+  if (length(input_path) == 0 || identical(input_path, "")) input_path <- list()
+
+  # Start of assertions
   checkmate::assert_string(label)
+
   checkmate::assert(
     checkmate::check_list(input_path, types = "character", min.len = 0),
     checkmate::check_character(input_path, min.len = 1)
   )
-
   if (length(input_path) > 0) {
     valid_url <- function(url_input, timeout = 2) {
       con <- try(url(url_input), silent = TRUE)
       check <- suppressWarnings(try(open.connection(con, open = "rt", timeout = timeout), silent = TRUE)[1])
       try(close.connection(con), silent = TRUE)
-      ifelse(is.null(check), TRUE, FALSE)
+      is.null(check)
     }
     idx <- vapply(input_path, function(x) file.exists(x) || valid_url(x), logical(1))
 
@@ -75,8 +74,9 @@ tm_file_viewer <- function(label = "File Viewer Module",
       "No file or url paths were provided."
     )
   }
+  # End of assertions
 
-
+  # Make UI args
   args <- as.list(environment())
 
   module(

R/tm_front_page.R

@@ -67,14 +67,18 @@ tm_front_page <- function(label = "Front page",
                           additional_tags = tagList(),
                           footnotes = character(0),
                           show_metadata = FALSE) {
+  logger::log_info("Initializing tm_front_page")
+
+  # Start of assertions
   checkmate::assert_string(label)
   checkmate::assert_character(header_text, min.len = 0, any.missing = FALSE)
   checkmate::assert_list(tables, types = "data.frame", names = "named", any.missing = FALSE)
   checkmate::assert_multi_class(additional_tags, classes = c("shiny.tag.list", "html"))
   checkmate::assert_character(footnotes, min.len = 0, any.missing = FALSE)
   checkmate::assert_flag(show_metadata)
+  # End of assertions
 
-  logger::log_info("Initializing tm_front_page")
+  # Make UI args
   args <- as.list(environment())
 
   module(

R/tm_g_association.R

@@ -131,30 +131,43 @@ tm_g_association <- function(label = "Association",
                              post_output = NULL,
                              ggplot2_args = teal.widgets::ggplot2_args()) {
   logger::log_info("Initializing tm_g_association")
+
+  # Normalize the parameters
   if (inherits(ref, "data_extract_spec")) ref <- list(ref)
   if (inherits(vars, "data_extract_spec")) vars <- list(vars)
   if (inherits(ggplot2_args, "ggplot2_args")) ggplot2_args <- list(default = ggplot2_args)
 
+  # Start of assertions
   checkmate::assert_string(label)
+
   checkmate::assert_list(ref, types = "data_extract_spec")
   if (!all(vapply(ref, function(x) !x$select$multiple, logical(1)))) {
     stop("'ref' should not allow multiple selection")
   }
+
   checkmate::assert_list(vars, types = "data_extract_spec")
   checkmate::assert_flag(show_association)
+
   checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
   checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
   checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
   checkmate::assert_numeric(
     plot_width[1],
     lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
   )
+
   distribution_theme <- match.arg(distribution_theme)
   association_theme <- match.arg(association_theme)
+
+  checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
+  checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
+
   plot_choices <- c("Bivariate1", "Bivariate2")
   checkmate::assert_list(ggplot2_args, types = "ggplot2_args")
   checkmate::assert_subset(names(ggplot2_args), c("default", plot_choices))
+  # End of assertions
 
+  # Make UI args
   args <- as.list(environment())
 
   data_extract_list <- list(

R/tm_g_bivariate.R

@@ -192,6 +192,8 @@ tm_g_bivariate <- function(label = "Bivariate Plots",
                            pre_output = NULL,
                            post_output = NULL) {
   logger::log_info("Initializing tm_g_bivariate")
+
+  # Normalize the parameters
   if (inherits(x, "data_extract_spec")) x <- list(x)
   if (inherits(y, "data_extract_spec")) y <- list(y)
   if (inherits(row_facet, "data_extract_spec")) row_facet <- list(row_facet)
@@ -200,52 +202,36 @@ tm_g_bivariate <- function(label = "Bivariate Plots",
   if (inherits(fill, "data_extract_spec")) fill <- list(fill)
   if (inherits(size, "data_extract_spec")) size <- list(size)
 
+  # Start of assertions
+  checkmate::assert_string(label)
+
   checkmate::assert_list(x, types = "data_extract_spec")
-  if (!all(vapply(x, function(x) !x$select$multiple, logical(1)))) {
-    stop("'x' should not allow multiple selection")
-  }
+  assert_single_selection(x)
+
   checkmate::assert_list(y, types = "data_extract_spec")
-  if (!all(vapply(y, function(x) !x$select$multiple, logical(1)))) {
-    stop("'y' should not allow multiple selection")
-  }
+  assert_single_selection(y)
+
   checkmate::assert_list(row_facet, types = "data_extract_spec", null.ok = TRUE)
-  if (!all(vapply(row_facet, function(x) !x$select$multiple, logical(1)))) {
-    stop("'row_facet' should not allow multiple selection")
-  }
+  assert_single_selection(row_facet)
+
   checkmate::assert_list(col_facet, types = "data_extract_spec", null.ok = TRUE)
-  if (!all(vapply(col_facet, function(x) !x$select$multiple, logical(1)))) {
-    stop("'col_facet' should not allow multiple selection")
-  }
+  assert_single_selection(col_facet)
+
+  checkmate::assert_flag(facet)
+
   checkmate::assert_list(color, types = "data_extract_spec", null.ok = TRUE)
-  if (!all(vapply(color, function(x) !x$select$multiple, logical(1)))) {
-    stop("'color' should not allow multiple selection")
-  }
+  assert_single_selection(color)
+
   checkmate::assert_list(fill, types = "data_extract_spec", null.ok = TRUE)
-  if (!all(vapply(fill, function(x) !x$select$multiple, logical(1)))) {
-    stop("'fill' should not allow multiple selection")
-  }
+  assert_single_selection(fill)
+
   checkmate::assert_list(size, types = "data_extract_spec", null.ok = TRUE)
-  if (!all(vapply(size, function(x) !x$select$multiple, logical(1)))) {
-    stop("'size' should not allow multiple selection")
-  }
+  assert_single_selection(size)
 
-  ggtheme <- match.arg(ggtheme)
-  checkmate::assert_string(label)
   checkmate::assert_flag(use_density)
-  checkmate::assert_flag(color_settings)
-  checkmate::assert_flag(free_x_scales)
-  checkmate::assert_flag(free_y_scales)
-  checkmate::assert_flag(rotate_xaxis_labels)
-  checkmate::assert_flag(swap_axes)
-  checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
-  checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
-  checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
-  checkmate::assert_numeric(
-    plot_width[1],
-    lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
-  )
-  checkmate::assert_class(ggplot2_args, "ggplot2_args")
 
+  # Determines color, fill & size if they are not explicitly set
+  checkmate::assert_flag(color_settings)
   if (color_settings) {
     if (is.null(color)) {
       color <- x
@@ -265,6 +251,28 @@ tm_g_bivariate <- function(label = "Bivariate Plots",
     }
   }
 
+  checkmate::assert_flag(free_x_scales)
+  checkmate::assert_flag(free_y_scales)
+
+  checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
+  checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
+  checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
+  checkmate::assert_numeric(
+    plot_width[1],
+    lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
+  )
+
+  checkmate::assert_flag(rotate_xaxis_labels)
+  checkmate::assert_flag(swap_axes)
+
+  ggtheme <- match.arg(ggtheme)
+  checkmate::assert_class(ggplot2_args, "ggplot2_args")
+
+  checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
+  checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
+  # End of assertions
+
+  # Make UI args
   args <- as.list(environment())
 
   data_extract_list <- list(