Fix deep tests (#429)

Install teal.slice as important fix has been merged recently
(insightsengineering/teal.slice#663). Please
remember to install teal.slice locally if you want to test this branch -
shinytest2 is run in the separate session so every packages must be
installed (load_all has no effect).

In this PR:
- needed to replace hardcoded ids of filter panel inputs with a
functional approach `!!ns_fs(<input path>) := <input value> `. Thanks to
this we just need to change "id" in one place if we ever change the
namespace in teal or teal.slice

---------

Co-authored-by: Lluís Revilla <[email protected]>
Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Co-authored-by: André Veríssimo <[email protected]>
Co-authored-by: Lluís Revilla <[email protected]>

Author: 4 people

.lintr

@@ -1,5 +1,5 @@
 linters: linters_with_defaults(
   line_length_linter = line_length_linter(120),
-  cyclocomp_linter = NULL,
+  pipe_consistency_linter = NULL,
   object_usage_linter = NULL
   )

R/adtteSpec.R

@@ -101,7 +101,7 @@ h_km_mae_to_adtte <- function(adtte,
 #' @return The UI part.
 #' @seealso [adtteSpecServer()] for the module server and a complete example.
 #' @export
-adtteSpecInput <- function(inputId, # nolint
+adtteSpecInput <- function(inputId, # nolint: object_name_linter.
                            label_paramcd = "Select Endpoint") {
   assert_string(inputId)
   assert_string(label_paramcd, min.chars = 1L)
@@ -240,7 +240,7 @@ adtteSpecInput <- function(inputId, # nolint
 #' if (interactive()) {
 #'   my_app()
 #' }
-adtteSpecServer <- function(id, # nolint
+adtteSpecServer <- function(id, # nolint: object_name_linter.
                             data,
                             mae_name,
                             adtte_name,

R/assaySpec.R

@@ -10,7 +10,7 @@
 #' @return The UI part.
 #' @seealso [assaySpecServer()] for the module server and a complete example.
 #' @export
-assaySpecInput <- function(inputId, # nolint
+assaySpecInput <- function(inputId, # nolint: object_name_linter.
                            label_assays = "Select Assay") {
   assert_string(inputId)
   assert_string(label_assays, min.chars = 1L)
@@ -97,7 +97,7 @@ assaySpecInput <- function(inputId, # nolint
 #' if (interactive()) {
 #'   my_app()
 #' }
-assaySpecServer <- function(id, # nolint
+assaySpecServer <- function(id, # nolint: object_name_linter.
                             assays,
                             exclude_assays = character()) {
   assert_string(id)

R/checkmate.R

@@ -37,13 +37,13 @@ NULL
 #' @examples
 #' check_tag("bla")
 #' check_tag(NULL, null.ok = TRUE)
-check_tag <- function(x, null.ok = FALSE) { # nolint
+check_tag <- function(x, null.ok = FALSE) { # nolint: object_name_linter.
   assert_flag(null.ok)
   ok <- (null.ok && test_null(x)) || test_class(x, "shiny.tag") || test_class(x, "shiny.tag.list")
   if (!ok) {
     return("Must be a 'shiny.tag' or NULL")
   }
-  return(TRUE)
+  TRUE
 }
 
 #' @rdname check_tag
@@ -106,7 +106,7 @@ test_reactive <- makeTestFunction(check_reactive)
 #'
 #' @examples
 #' assert_summary_funs(list(mean = colMeans, raw = NULL), null.ok = TRUE)
-assert_summary_funs <- function(x, null.ok = FALSE) { # nolint
+assert_summary_funs <- function(x, null.ok = FALSE) { # nolint: object_name_linter.
   assert_flag(null.ok)
   assert_list(
     x,

R/experimentSpec.R

@@ -10,7 +10,7 @@
 #' @return The UI part.
 #' @seealso [experimentSpecServer()] for the module server and a complete example.
 #' @export
-experimentSpecInput <- function(inputId, # nolint
+experimentSpecInput <- function(inputId, # nolint: object_name_linter.
                                 data,
                                 mae_name,
                                 label_experiments = "Select Experiment") {
@@ -205,7 +205,7 @@ h_gene_data <- function(object, name_annotation) {
 #' if (interactive()) {
 #'   my_app()
 #' }
-experimentSpecServer <- function(id, # nolint
+experimentSpecServer <- function(id, # nolint: object_name_linter.
                                  data,
                                  filter_panel_api,
                                  mae_name,
@@ -277,7 +277,7 @@ experimentSpecServer <- function(id, # nolint
       data = data_return,
       name = reactive({
         input$name
-      }), # nolint
+      }),
       genes = genes,
       assays = assays
     )

R/geneSpec.R

@@ -23,7 +23,7 @@
 #'
 #' @examples
 #' geneSpecInput("my_genes", list(mean = colMeans), label_funs = "Please select function")
-geneSpecInput <- function(inputId, # nolint
+geneSpecInput <- function(inputId, # nolint: object_name_linter.
                           funs,
                           label_genes = "Select Gene(s)",
                           label_funs = "Select Gene Summary",
@@ -148,7 +148,7 @@ geneSpecInput <- function(inputId, # nolint
 #'
 #' @export
 h_update_gene_selection <- function(session,
-                                    inputId, # nolint
+                                    inputId, # nolint: object_name_linter.
                                     selected,
                                     choices) {
   is_new_selected <- selected %in% choices$id
@@ -285,7 +285,7 @@ h_parse_genes <- function(words, choices) {
 #' if (interactive()) {
 #'   my_app()
 #' }
-geneSpecServer <- function(id, # nolint
+geneSpecServer <- function(id, # nolint: object_name_linter.
                            funs,
                            gene_choices,
                            label_modal_title = "Enter list of genes",
@@ -378,7 +378,7 @@ geneSpecServer <- function(id, # nolint
     })
 
     # Return the UI for a modal dialog with gene text input, showing examples.
-    dataModal <- function(example_list) { # nolint
+    dataModal <- function(example_list) { # nolint: object_name_linter.
       modalDialog(
         textInput(
           session$ns("gene_text"),

R/sampleVarSpec.R

@@ -14,7 +14,7 @@
 #'
 #' @examples
 #' sampleVarSpecInput("my_vars", label_vars = "Select faceting variable")
-sampleVarSpecInput <- function(inputId, # nolint
+sampleVarSpecInput <- function(inputId, # nolint: object_name_linter.
                                label_vars = "Select sample variable",
                                label_levels_button = "Combine factor levels") {
   assert_string(inputId)
@@ -261,7 +261,7 @@ validate_n_levels <- function(x, name, n_levels) {
 #' if (interactive()) {
 #'   my_app()
 #' }
-sampleVarSpecServer <- function(id, # nolint
+sampleVarSpecServer <- function(id, # nolint: object_name_linter.
                                 experiment_name,
                                 original_data,
                                 transformed_data = original_data,
@@ -366,7 +366,7 @@ sampleVarSpecServer <- function(id, # nolint
 
     # Function to return the UI for a modal dialog with matrix input for combination
     # assignment.
-    combModal <- function(sample_var_levels, # nolint
+    combModal <- function(sample_var_levels, # nolint: object_name_linter.
                           n_max_groups,
                           selected_groups) {
       if (is.null(selected_groups)) {
@@ -416,9 +416,9 @@ sampleVarSpecServer <- function(id, # nolint
 
           old_values <- names(assign_lists[[experiment_name]][[sample_var]])
           if (!is.null(old_values) &&
-            length(old_values) == length(sample_var_levels) && # nolint
-            all(sort(old_values) == sort(sample_var_levels))) { # nolint
-            selected_groups <- assign_lists[[experiment_name]][[sample_var]] # nolint
+            length(old_values) == length(sample_var_levels) && # nolint: indentation_linter.
+            all(sort(old_values) == sort(sample_var_levels))) {
+            selected_groups <- assign_lists[[experiment_name]][[sample_var]]
           }
 
           showModal(combModal(
@@ -490,14 +490,14 @@ sampleVarSpecServer <- function(id, # nolint
 #'   experiment_name = reactive({
 #'     input$experiment_name
 #'   }),
-#'   original_data = ori_data # nolint Please update the <ori_data>
+#'   original_data = ori_data # Please update the <ori_data>
 #' )
 #' # Then can extract the transformed data and selected variables later:
 #' experiment_data <- sample_var_specs$experiment_data()
 #' facet_var <- sample_var_specs$vars$facet_var()
 #' color_var <- sample_var_specs$vars$color_var()
 #' }
-multiSampleVarSpecServer <- function(inputIds, # nolint
+multiSampleVarSpecServer <- function(inputIds, # nolint: object_name_linter.
                                      original_data,
                                      ...) {
   assert_character(inputIds, any.missing = FALSE, unique = TRUE)

R/tm_g_barplot.R

@@ -272,7 +272,7 @@ srv_g_barplot <- function(id,
 sample_tm_g_barplot <- function(.test = FALSE) {
   data <- within(
     teal.data::teal_data(),
-    MAE <- hermes::multi_assay_experiment # nolint
+    MAE <- hermes::multi_assay_experiment # nolint: object_name_linter.
   )
   app <- teal::init(
     data = data,

R/tm_g_boxplot.R

@@ -284,7 +284,7 @@ srv_g_boxplot <- function(id,
 sample_tm_g_boxplot <- function(.test = FALSE) {
   data <- within(
     teal.data::teal_data(),
-    MAE <- hermes::multi_assay_experiment # nolint
+    MAE <- hermes::multi_assay_experiment # nolint: object_name_linter.
   )
   app <- teal::init(
     data = data,

R/tm_g_forest_tte.R

@@ -306,11 +306,11 @@ srv_g_forest_tte <- function(id,
 #' if (interactive()) {
 #'   sample_tm_g_forest_tte()
 #' }
-sample_tm_g_forest_tte <- function(.test = FALSE) { # nolint
+sample_tm_g_forest_tte <- function(.test = FALSE) {
   data <- within(teal.data::teal_data(), {
-    ADTTE <- teal.data::rADTTE |> # nolint
+    ADTTE <- teal.data::rADTTE |> # nolint: object_name_linter.
       dplyr::mutate(is_event = .data$CNSR == 0)
-    MAE <- hermes::multi_assay_experiment # nolint
+    MAE <- hermes::multi_assay_experiment # nolint: object_name_linter.
   })
   join_keys(data)["ADTTE", "ADTTE"] <- c("STUDYID", "USUBJID", "PARAMCD")