insightsengineering · averissimo · Feb 14, 2024 · Feb 8, 2024 · Feb 8, 2024 · Feb 9, 2024
diff --git a/.lintr b/.lintr
@@ -1,5 +1,6 @@
 linters: linters_with_defaults(
   line_length_linter = line_length_linter(120),
   cyclocomp_linter = NULL,
-  object_usage_linter = NULL
+  object_usage_linter = NULL,
+  object_name_linter = object_name_linter(styles = c("snake_case", "symbols"), regexes = c(ANL = "^ANL_?[0-9]*$", ADaM = "^r?AD[A-Z]{2,3}_?[0-9]*$"))
   )
diff --git a/R/Queue.R b/R/Queue.R
@@ -17,7 +17,7 @@
 #' @name Queue
 #' @keywords internal
 #'
-Queue <- R6::R6Class( # nolint
+Queue <- R6::R6Class( # nolint: object_name_linter.
   classname = "Queue",
   # public methods ----
   public = list(

diff --git a/R/choices_labeled.R b/R/choices_labeled.R
@@ -191,8 +191,7 @@ variable_choices.character <- function(data, subset = NULL, fill = FALSE, key =
 
 #' @rdname variable_choices
 #' @export
-variable_choices.data.frame <- function(data, subset = NULL, fill = TRUE, key = NULL) { # nolint
-
+variable_choices.data.frame <- function(data, subset = NULL, fill = TRUE, key = NULL) {
   checkmate::assert(
     checkmate::check_character(subset, null.ok = TRUE),
     checkmate::check_function(subset, null.ok = TRUE)
@@ -316,7 +315,7 @@ value_choices.character <- function(data,
 
 #' @rdname value_choices
 #' @export
-value_choices.data.frame <- function(data, # nolint
+value_choices.data.frame <- function(data,
                                      var_choices,
                                      var_label = NULL,
                                      subset = NULL,

diff --git a/R/choices_selected.R b/R/choices_selected.R
@@ -191,7 +191,7 @@ choices_selected <- function(choices,
 #'
 #' @export
 #'
-is.choices_selected <- function(x) { # nolint
+is.choices_selected <- function(x) { # nolint: object_name_linter.
   inherits(x, "choices_selected")
 }
 
@@ -231,7 +231,7 @@ add_no_selected_choices <- function(x, multiple = FALSE) {
 #'
 #' @export
 #'
-no_selected_as_NULL <- function(x) { # nolint
+no_selected_as_NULL <- function(x) { # nolint: object_name_linter.
   if (is.null(x) || identical(x, no_select_keyword) || x == "") {
     NULL
   } else {

diff --git a/R/data_extract_module.R b/R/data_extract_module.R
@@ -457,10 +457,16 @@ data_extract_srv.FilteredData <- function(id, datasets, data_extract_spec, ...)
 #' `select_validation_rule` but for the choose dataset part of the `data_extract_ui`
 #' @export
 #'
-data_extract_srv.list <- function(id, datasets, data_extract_spec, join_keys = NULL,
+data_extract_srv.list <- function(id,
+                                  datasets,
+                                  data_extract_spec,
+                                  join_keys = NULL,
                                   select_validation_rule = NULL,
                                   filter_validation_rule = NULL,
-                                  dataset_validation_rule = if (is.null(select_validation_rule) && is.null(filter_validation_rule)) { # nolint
+                                  dataset_validation_rule = if (
+                                    is.null(select_validation_rule) &&
+                                      is.null(filter_validation_rule)
+                                  ) {
                                     NULL
                                   } else {
                                     shinyvalidate::sv_required("Please select a dataset")
@@ -738,14 +744,20 @@ data_extract_multiple_srv.FilteredData <- function(data_extract, datasets, ...)
 #'
 #' @export
 #'
-data_extract_multiple_srv.list <- function(data_extract, datasets, join_keys = NULL,
+data_extract_multiple_srv.list <- function(data_extract,
+                                           datasets,
+                                           join_keys = NULL,
                                            select_validation_rule = NULL,
                                            filter_validation_rule = NULL,
-                                           dataset_validation_rule = if (is.null(select_validation_rule) && is.null(filter_validation_rule)) { # nolint
+                                           dataset_validation_rule = if (
+                                             is.null(select_validation_rule) &&
+                                               is.null(filter_validation_rule)
+                                           ) {
                                              NULL
                                            } else {
                                              shinyvalidate::sv_required("Please select a dataset")
-                                           }, ...) {
+                                           },
+                                           ...) {
   checkmate::assert_list(datasets, types = c("reactive", "data.frame"), names = "named")
   checkmate::assert_class(join_keys, "join_keys", null.ok = TRUE)
   checkmate::assert(

diff --git a/R/filter_spec.R b/R/filter_spec.R
@@ -285,7 +285,7 @@ filter_spec_internal <- function(vars_choices,
 
 #' @rdname filter_spec_internal
 #' @export
-filter_spec_internal.delayed_data <- function(vars_choices, # nolint
+filter_spec_internal.delayed_data <- function(vars_choices,
                                               vars_selected = NULL,
                                               vars_label = NULL,
                                               vars_fixed = FALSE,

diff --git a/R/get_dplyr_call.R b/R/get_dplyr_call.R
@@ -82,7 +82,7 @@ get_dplyr_call_data <- function(selector_list, join_keys = teal.data::join_keys(
       all_cols
     )
 
-    pivot_longer_unite_cols_renamed <- if (rlang::is_empty(unite_vals)) { # nolint
+    pivot_longer_unite_cols_renamed <- if (rlang::is_empty(unite_vals)) { # nolint: object_length_linter.
       pivot_longer_cols_renamed
     } else {
       Reduce(

diff --git a/R/get_merge_call.R b/R/get_merge_call.R
@@ -57,7 +57,7 @@ get_merge_call <- function(selector_list,
     anl_merge_call_i <- call(
       "<-",
       as.name(anl_name),
-      { # nolint
+      {
         merge_key_i <- get_merge_key_i(idx = idx, dplyr_call_data = dplyr_call_data)
         is_merge_key_pair <- vapply(merge_key_i, function(x) length(names(x)) == 1, logical(1))
 

diff --git a/R/select_spec.R b/R/select_spec.R
@@ -109,7 +109,7 @@ select_spec <- function(choices,
 #' @rdname select_spec
 #' @export
 #'
-select_spec.delayed_data <- function(choices, # nolint
+select_spec.delayed_data <- function(choices, # nolint: object_name_linter.
                                      selected = NULL,
                                      multiple = length(selected) > 1,
                                      fixed = FALSE,
@@ -144,7 +144,7 @@ select_spec.delayed_data <- function(choices, # nolint
 #' @rdname select_spec
 #' @export
 #'
-select_spec.default <- function(choices, # nolint
+select_spec.default <- function(choices, # nolint: object_name_linter.
                                 selected = choices[1],
                                 multiple = length(selected) > 1,
                                 fixed = FALSE,

diff --git a/R/zzz.R b/R/zzz.R
@@ -1,4 +1,4 @@
-.onLoad <- function(libname, pkgname) { # nolint
+.onLoad <- function(libname, pkgname) {
   teal.logger::register_logger("teal.transform")
   invisible()
 }
diff --git a/data-raw/data.R b/data-raw/data.R
@@ -1,18 +1,18 @@
 ## code to prepare `data` for testing examples
 library(scda)
-rADAE <- synthetic_cdisc_data("latest")$adae # nolint
+rADAE <- synthetic_cdisc_data("latest")$adae
 usethis::use_data(rADAE)
 
-rADLB <- synthetic_cdisc_data("latest")$adlb # nolint
+rADLB <- synthetic_cdisc_data("latest")$adlb
 usethis::use_data(rADLB)
 
-rADRS <- synthetic_cdisc_data("latest")$adrs # nolint
+rADRS <- synthetic_cdisc_data("latest")$adrs
 usethis::use_data(rADRS)
 
-rADSL <- synthetic_cdisc_data("latest")$adsl # nolint
+rADSL <- synthetic_cdisc_data("latest")$adsl
 usethis::use_data(rADSL)
 
-rADTTE <- synthetic_cdisc_data("latest")$adtte # nolint
+rADTTE <- synthetic_cdisc_data("latest")$adtte
 usethis::use_data(rADTTE)
 
 # Use <pkg>:: prefix in examples/tests/vignettes when accessing rAD## data

diff --git a/tests/testthat/test-data_extract_module.R b/tests/testthat/test-data_extract_module.R
@@ -1,5 +1,5 @@
-ADLB <- teal.transform::rADLB # nolint
-ADTTE <- teal.transform::rADTTE # nolint
+ADLB <- teal.transform::rADLB
+ADTTE <- teal.transform::rADTTE
 
 testthat::test_that("Single filter", {
   data_extract <- data_extract_spec(
@@ -23,9 +23,12 @@ testthat::test_that("Single filter", {
 
   testthat::expect_silent(input <- data_extract_single_ui(id = NULL, data_extract))
   testthat::expect_silent(filter <- input$children[[1]])
-  testthat::expect_equal(filter$children[[1]]$children[[1]]$attribs, list(class = "shinyjs-hide")) # nolint
+  testthat::expect_equal(filter$children[[1]]$children[[1]]$attribs, list(class = "shinyjs-hide"))
 
-  testthat::expect_equal(filter$children[[1]]$children[[2]]$children[[4]]$children[[1]]$children[[1]]$children[[2]]$attribs$multiple, "multiple") # nolint
+  testthat::expect_equal(
+    filter$children[[1]]$children[[2]]$children[[4]]$children[[1]]$children[[1]]$children[[2]]$attribs$multiple,
+    "multiple"
+  )
 
   # more tests - check levels of filtered variables
   # check also colummns selected

diff --git a/tests/testthat/test-data_extract_multiple_srv.R b/tests/testthat/test-data_extract_multiple_srv.R
@@ -1,6 +1,6 @@
-ADSL <- teal.transform::rADSL # nolint
-ADLB <- teal.transform::rADLB # nolint
-ADTTE <- teal.transform::rADTTE # nolint
+ADSL <- teal.transform::rADSL
+ADLB <- teal.transform::rADLB
+ADTTE <- teal.transform::rADTTE
 
 data_list <- list(ADSL = reactive(ADSL), ADTTE = reactive(ADTTE), ADLB = reactive(ADLB))
 join_keys <- teal.data::default_cdisc_join_keys[c("ADSL", "ADTTE", "ADLB")]

diff --git a/tests/testthat/test-data_extract_spec.R b/tests/testthat/test-data_extract_spec.R
@@ -1,3 +1,32 @@
+ADSL <- teal.transform::rADSL
+ADTTE <- teal.transform::rADTTE
+data_list <- list(ADSL = reactive(ADSL), ADTTE = reactive(ADTTE))
+key_list <- list(ADSL = c("STUDYID", "USUBJID"), ADTTE = c("STUDYID", "USUBJID", "PARAMCD"))
+
+vc_hard <- variable_choices("ADSL", subset = c("STUDYID", "USUBJID"))
+vc_hard_exp <- structure(
+  list(data = "ADSL", subset = c("STUDYID", "USUBJID"), key = NULL),
+  class = c("delayed_variable_choices", "delayed_data", "choices_labeled")
+)
+
+vc_hard_short <- variable_choices("ADSL", subset = "STUDYID")
+vc_hard_short_exp <- structure(
+  list(data = "ADSL", subset = "STUDYID", key = NULL),
+  class = c("delayed_variable_choices", "delayed_data", "choices_labeled")
+)
+
+vc_fun <- variable_choices("ADSL", subset = function(data) colnames(data)[1:2])
+vc_fun_exp <- structure(
+  list(data = "ADSL", subset = function(data) colnames(data)[1:2], key = NULL),
+  class = c("delayed_variable_choices", "delayed_data", "choices_labeled")
+)
+
+vc_fun_short <- variable_choices("ADSL", subset = function(data) colnames(data)[1])
+vc_fun_short_exp <- structure(
+  list(data = "ADSL", subset = function(data) colnames(data)[1], key = NULL),
+  class = c("delayed_variable_choices", "delayed_data", "choices_labeled")
+)
+
 testthat::test_that("data_extract_spec throws when select is not select_spec or NULL", {
   testthat::expect_error(data_extract_spec("toyDataset", select = c("A", "B")))
 })
@@ -100,14 +129,14 @@ testthat::test_that("data_extract_spec works with valid input", {
 
 testthat::test_that("delayed data_extract_spec works", {
   set.seed(1)
-  ADSL <- data.frame( # nolint
+  ADSL <- data.frame(
     USUBJID = letters[1:10],
     SEX = sample(c("F", "M", "U"), 10, replace = TRUE),
     BMRKR1 = rnorm(10),
     BMRKR2 = sample(c("L", "M", "H"), 10, replace = TRUE),
     stringsAsFactors = FALSE
   )
-  attr(ADSL, "keys") <- c("STUDYID", "USUBJID") # nolint
+  attr(ADSL, "keys") <- c("STUDYID", "USUBJID")
 
   filter_normal <- filter_spec(
     vars = variable_choices(ADSL, "SEX"),
@@ -199,35 +228,6 @@ testthat::test_that("delayed data_extract_spec works", {
   testthat::expect_identical(expected_spec, mix3_res)
 })
 
-ADSL <- teal.transform::rADSL # nolint
-ADTTE <- teal.transform::rADTTE # nolint
-data_list <- list(ADSL = reactive(ADSL), ADTTE = reactive(ADTTE))
-key_list <- list(ADSL = c("STUDYID", "USUBJID"), ADTTE = c("STUDYID", "USUBJID", "PARAMCD"))
-
-vc_hard <- variable_choices("ADSL", subset = c("STUDYID", "USUBJID"))
-vc_hard_exp <- structure(
-  list(data = "ADSL", subset = c("STUDYID", "USUBJID"), key = NULL),
-  class = c("delayed_variable_choices", "delayed_data", "choices_labeled")
-)
-
-vc_hard_short <- variable_choices("ADSL", subset = "STUDYID")
-vc_hard_short_exp <- structure(
-  list(data = "ADSL", subset = "STUDYID", key = NULL),
-  class = c("delayed_variable_choices", "delayed_data", "choices_labeled")
-)
-
-vc_fun <- variable_choices("ADSL", subset = function(data) colnames(data)[1:2])
-vc_fun_exp <- structure(
-  list(data = "ADSL", subset = function(data) colnames(data)[1:2], key = NULL),
-  class = c("delayed_variable_choices", "delayed_data", "choices_labeled")
-)
-
-vc_fun_short <- variable_choices("ADSL", subset = function(data) colnames(data)[1])
-vc_fun_short_exp <- structure(
-  list(data = "ADSL", subset = function(data) colnames(data)[1], key = NULL),
-  class = c("delayed_variable_choices", "delayed_data", "choices_labeled")
-)
-
 testthat::test_that("delayed version of data_extract_spec", {
   # hard-coded subset
   obj <- data_extract_spec(
@@ -328,14 +328,14 @@ testthat::test_that("data_extract_spec returns select_spec with multiple set to
 # with resolve_delayed
 testthat::test_that("delayed data_extract_spec works - resolve_delayed", {
   set.seed(1)
-  ADSL <- data.frame( # nolint
+  ADSL <- data.frame(
     USUBJID = letters[1:10],
     SEX = sample(c("F", "M", "U"), 10, replace = TRUE),
     BMRKR1 = rnorm(10),
     BMRKR2 = sample(c("L", "M", "H"), 10, replace = TRUE),
     stringsAsFactors = FALSE
   )
-  attr(ADSL, "keys") <- c("STUDYID", "USUBJID") # nolint
+  attr(ADSL, "keys") <- c("STUDYID", "USUBJID")
 
   filter_normal <- filter_spec(
     vars = variable_choices(ADSL, "SEX"),
@@ -427,7 +427,6 @@ testthat::test_that("delayed data_extract_spec works - resolve_delayed", {
   testthat::expect_identical(expected_spec, mix3_res)
 })
 
-
 testthat::test_that("delayed version of data_extract_spec - resolve_delayed", {
   data_list <- list(ADSL = reactive(ADSL))
   keys_list <- list(ADSL = c("STUDYID", "USUBJID"))

diff --git a/tests/testthat/test-data_extract_srv.R b/tests/testthat/test-data_extract_srv.R
@@ -1,6 +1,6 @@
-ADSL <- teal.transform::rADSL # nolint
-ADLB <- teal.transform::rADLB # nolint
-ADTTE <- teal.transform::rADTTE # nolint
+ADSL <- teal.transform::rADSL
+ADLB <- teal.transform::rADLB
+ADTTE <- teal.transform::rADTTE
 
 data_list <- list(ADSL = reactive(ADSL), ADTTE = reactive(ADTTE), ADLB = reactive(ADLB))
 join_keys <- teal.data::default_cdisc_join_keys[c("ADSL", "ADTTE", "ADLB")]

diff --git a/tests/testthat/test-delayed_data_extract.R b/tests/testthat/test-delayed_data_extract.R
@@ -1,9 +1,9 @@
 # Contains integration tests between delayed data loading objects and
 # the objects responsible for loading, pulling and filtering the data
-ADSL <- teal.transform::rADSL # nolint
-ADTTE <- teal.transform::rADTTE # nolint
-ADAE <- teal.transform::rADAE # nolint
-ADRS <- teal.transform::rADRS # nolint
+ADSL <- teal.transform::rADSL
+ADTTE <- teal.transform::rADTTE
+ADAE <- teal.transform::rADAE
+ADRS <- teal.transform::rADRS
 
 data_list <- list(ADSL = reactive(ADSL), ADTTE = reactive(ADTTE), ADAE = reactive(ADAE), ADRS = reactive(ADRS))
 join_keys <- teal.data::default_cdisc_join_keys[c("ADSL", "ADTTE", "ADAE", "ADRS")]