Apply stylr to whole package

R/add_event_index.R

@@ -18,8 +18,7 @@
 #'
 #' @noRd
 
-create_flag <- function(dat, var_value_pairs=NULL, singletons=NULL) {
-
+create_flag <- function(dat, var_value_pairs = NULL, singletons = NULL) {
  filter_str <-
  construct_data_filter_logic(
  var_value_pairs = var_value_pairs,
@@ -42,7 +41,7 @@ create_flag <- function(dat, var_value_pairs=NULL, singletons=NULL) {
 #' of the columns `pop_var`, `pop_value`, `period_var`, `period_value`,
 #' `endpoint_filter`, `endpoint_group_filter`, and `custom_pop_filter`, which
 #' are used to define the conditions for event indexing.
-#' 
+#'
 #' @param analysis_data_container A data.table containing the analysis data.
 #'
 #' @return A `data.table` similar to the input but with an additional
@@ -57,11 +56,16 @@ add_event_index <- function(ep, analysis_data_container) {
  ep_out[, event_index := llist(
  create_flag(
  dat[[1]],
- var_value_pairs = list(c(pop_var[[1]], pop_value[[1]]),
- c(period_var[[1]], period_value[[1]])),
- singletons = c(endpoint_filter[[1]],
- endpoint_group_filter[[1]],
- custom_pop_filter[[1]])
- )), by = endpoint_id]
- ep_out[, dat:=NULL]
+ var_value_pairs = list(
+ c(pop_var[[1]], pop_value[[1]]),
+ c(period_var[[1]], period_value[[1]])
+ ),
+ singletons = c(
+ endpoint_filter[[1]],
+ endpoint_group_filter[[1]],
+ custom_pop_filter[[1]]
+ )
+ )
+ ), by = endpoint_id]
+ ep_out[, dat := NULL]
 }

R/add_id.R

@@ -4,7 +4,7 @@
 #'
 #' @return data.table
 #' @export
-add_id <- function(ep){
+add_id <- function(ep) {
  x <- copy(ep)
  x[, endpoint_spec_id := .I]
  x[]

R/apply_criterion.R

@@ -149,7 +149,7 @@ apply_criterion_by_strata <-
 #' @noRd
 unnest_ep_by_strata <- function(ep) {
  ep_accepted <- ep[(crit_accept_endpoint)]
- ep_accepted[,strata_var := stratify_by]
+ ep_accepted[, strata_var := stratify_by]
  ep_unnested <-
  tidyr::unnest(ep_accepted, col = strata_var) |>
  setDT()

R/apply_stats.R

@@ -16,16 +16,17 @@
 apply_stats <-
  function(ep,
  analysis_data_container,
- type = c("stat_by_strata_by_trt",
- "stat_by_strata_across_trt",
- "stat_across_strata_across_trt")) {
-
+ type = c(
+ "stat_by_strata_by_trt",
+ "stat_by_strata_across_trt",
+ "stat_across_strata_across_trt"
+ )) {
  checkmate::assert_data_table(ep)
  # If no functions are given by the user, no results table needs to be
  # produced
  nm <- names(ep)
  if (length(nm) <= 3 &&
-  nm[1] == "SKIP_") {
+ nm[1] == "SKIP_") {
  return(data.table(NULL))
  }
  type <- match.arg(type)
@@ -34,8 +35,7 @@ apply_stats <-
  ep_cp <- ep[analysis_data_container]
 
  if (type == "stat_by_strata_by_trt") {
-
- if (nrow(ep_cp[crit_accept_by_strata_by_trt == TRUE]) == 0){
+ if (nrow(ep_cp[crit_accept_by_strata_by_trt == TRUE]) == 0) {
  ep_cp[, stat_result := list()]
  } else {
  ep_cp[crit_accept_by_strata_by_trt == TRUE, stat_result := llist(
@@ -56,10 +56,8 @@ apply_stats <-
  )
  ), by = stat_result_id]
  }
-
  } else if (type == "stat_by_strata_across_trt") {
-
- if (nrow(ep_cp[crit_accept_by_strata_across_trt == TRUE]) == 0 ){
+ if (nrow(ep_cp[crit_accept_by_strata_across_trt == TRUE]) == 0) {
  ep_cp[, stat_result := list()]
  } else {
  ep_cp[crit_accept_by_strata_across_trt == TRUE, stat_result := llist(
@@ -73,17 +71,16 @@ apply_stats <-
  event_index = unlist(event_index),
  cell_index = unlist(cell_index),
  subjectid_var = "USUBJID"
-  ),
+ ),
  validator = validate_stat_output,
  expr_name = fn_name
  )
  ), by = stat_result_id]
  }
- } else if (type == "stat_across_strata_across_trt"){
- if (nrow(ep_cp[crit_accept_by_strata_across_trt == TRUE]) == 0 ){
+ } else if (type == "stat_across_strata_across_trt") {
+ if (nrow(ep_cp[crit_accept_by_strata_across_trt == TRUE]) == 0) {
  ep_cp[, stat_result := list()]
  } else {
-
  ep_cp[crit_accept_by_strata_across_trt == TRUE, stat_result := llist(
  expr_ = try_and_validate(
  fn_callable[[1]](
@@ -103,5 +100,4 @@ apply_stats <-
 
  keep <- setdiff(names(ep_cp), c("fn_callable", "dat", "tar_group"))
  ep_cp[, .SD, .SDcols = keep]
-
  }

R/check_duplicate_functions.R

@@ -7,7 +7,7 @@
 #' @export
 #'
 check_duplicate_functions <- function(dir) {
- if(!dir.exists(dir)){
+ if (!dir.exists(dir)) {
  stop(paste0("Directory ", dir, " does not exist"))
  }
  dir_norm <- normalizePath(dir)
@@ -16,8 +16,9 @@ check_duplicate_functions <- function(dir) {
  fn_names_ls <- lapply(x, function(i) {
  lang_objs <- Filter(is.language, parse(i))
  fun_entries <-
- Filter(function(x)
- grepl(", function", toString(x)), lang_objs)
+ Filter(function(x) {
+ grepl(", function", toString(x))
+ }, lang_objs)
  sapply(fun_entries, function(fun_entry_i) {
  trimws(strsplit(toString(fun_entry_i), ",")[[1]][2])
  })
@@ -37,6 +38,4 @@ check_duplicate_functions <- function(dir) {
  "\n\n Please change the name so there are no duplicated names, otherwise it will be unclear which function will be used in the program.\n"
  )
  )
-
-
 }

R/construct_data_filter_logic.R

@@ -27,15 +27,12 @@ construct_data_filter_logic <-
  }
  if (!is.null(singletons)) {
  singletons_no_na <- singletons[!sapply(singletons, is_null_or_na)]
- if(length(singletons_no_na)>0){
+ if (length(singletons_no_na) > 0) {
  singletons_collapsed <- paste0(singletons_no_na, collapse = " & ")
  }
-
  }
- paste0(c(pairs, singletons_collapsed),collapse = " & ")
-
-
+ paste0(c(pairs, singletons_collapsed), collapse = " & ")
  }
-is_null_or_na <- function(x){
- is.null(x)||is.na(x)
+is_null_or_na <- function(x) {
+ is.null(x) || is.na(x)
 }

R/eval_fn.R

@@ -1,11 +1,13 @@
-
 eval_data_fn <- function(fn_list, ...) {
  out <- lapply(fn_list, function(fn) {
- x <- tryCatch({
- fn(...) # apply the function i
- }, error = function(e) {
- return(e)
- })
+ x <- tryCatch(
+ {
+ fn(...) # apply the function i
+ },
+ error = function(e) {
+ return(e)
+ }
+ )
 
  if (inherits(x, "simpleError") || inherits(x, "error")) {
  return(list(
@@ -15,20 +17,18 @@ eval_data_fn <- function(fn_list, ...) {
  ))
  }
 
- x[, "TOTAL_":="total"]
- x[, "INDEX_":= .I]
+ x[, "TOTAL_" := "total"]
+ x[, "INDEX_" := .I]
  setkey(x, "INDEX_")
 
  return(list(
  result = x,
  error_flag = FALSE,
  error_message = NULL
  ))
-
  })
 
  purrr::transpose(out)
-
 }
 
 #' Evaluate Endpoint Criteria
@@ -44,21 +44,24 @@ eval_data_fn <- function(fn_list, ...) {
 eval_criteria_endpoint <- function(fn, ...) {
  dots <- list(...)
  result <- fn(
- dat = dots$dat,
- event_index = dots$event_index,
- treatment_var = dots$treatment_var,
- treatment_refval = dots$treatment_refval,
- period_var = dots$period_var,
- period_value = dots$period_value,
- endpoint_filter = dots$endpoint_filter,
- endpoint_group_metadata = dots$endpoint_group_metadata,
- stratify_by = dots$stratify_by,
- subjectid_var = dots$subjectid_var)
+ dat = dots$dat,
+ event_index = dots$event_index,
+ treatment_var = dots$treatment_var,
+ treatment_refval = dots$treatment_refval,
+ period_var = dots$period_var,
+ period_value = dots$period_value,
+ endpoint_filter = dots$endpoint_filter,
+ endpoint_group_metadata = dots$endpoint_group_metadata,
+ stratify_by = dots$stratify_by,
+ subjectid_var = dots$subjectid_var
+ )
 
  if (!(isTRUE(result) |
- isFALSE(result))) {
- stop("The return value from the endpoint criterion function must be a logical of length 1, i.e.",
- "TRUE or FALSE")
+ isFALSE(result))) {
+ stop(
+ "The return value from the endpoint criterion function must be a logical of length 1, i.e.",
+ "TRUE or FALSE"
+ )
  }
  result
 }
@@ -86,11 +89,14 @@ eval_criteria_subgroup <- function(fn, ...) {
  endpoint_filter = dots$endpoint_filter,
  endpoint_group_metadata = dots$endpoint_group_metadata,
  strata_var = dots$strata_var,
- subjectid_var = dots$subjectid_var)
+ subjectid_var = dots$subjectid_var
+ )
  if (!(isTRUE(result) |
- isFALSE(result))) {
- stop("The return value from the endpoint criterion function must be a logical of length 1, i.e.",
- "TRUE or FALSE")
+ isFALSE(result))) {
+ stop(
+ "The return value from the endpoint criterion function must be a logical of length 1, i.e.",
+ "TRUE or FALSE"
+ )
  }
  result
 }

R/evaluate_criteria.R

@@ -11,15 +11,16 @@
 #' whether to keep the endpoint/strata or not.
 #' @export
 #'
-evaluate_criteria <- function(endpoints, adam_set, criteria_type = c("endpoint", "subgroup_description", "subgroup_analysis")){
-checkmate::assertDataTable(endpoints)
+evaluate_criteria <- function(endpoints, adam_set, criteria_type = c("endpoint", "subgroup_description", "subgroup_analysis")) {
+ checkmate::assertDataTable(endpoints)
 
  endpoints_out <- data.table::copy(endpoints)
 
  # Apply row-wise operations over the endpoint data to enrich data with an
  # evaluation of criteria and an updated log
- endpoints_out[, c(paste0("keep_",criteria_type), "log") := criterion_wrapper(.SD, adam_set, criteria_type),
- by = seq_len(nrow(endpoints_out))]
+ endpoints_out[, c(paste0("keep_", criteria_type), "log") := criterion_wrapper(.SD, adam_set, criteria_type),
+ by = seq_len(nrow(endpoints_out))
+ ]
 
  return(endpoints_out[])
 }