Fixing bug that appears when no grouping is present in the endpoint specifications

NAMESPACE

@@ -18,7 +18,6 @@ export(format_stats_results)
 export(group_ep_for_targets)
 export(index_expanded_ep_groups)
 export(index_non_null_group_level)
-export(join_adam)
 export(llist)
 export(load_debug_session)
 export(mk_endpoint_str)

R/add_event_index.R

@@ -42,6 +42,8 @@ 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
 #' `event_index` column, which contains the indices of events as determined by

R/add_id.R

@@ -1,6 +1,6 @@
 #' Add ID to user-defined endpoint groups
 #'
-#' @param ep
+#' @param ep A `data.table` containing endpoint definitions.
 #'
 #' @return data.table
 #' @export

R/apply_criterion.R

@@ -6,6 +6,7 @@
 #'
 #' @param ep A `data.table` containing expanded endpoint definitions and
 #' associated data, typically the output from `add_event_index`.
+#' @param analysis_data_container data.table containing the analysis data.
 #' @param fn_map A `data.table` mapping endpoint definitions to criterion
 #' functions.
 #'
@@ -60,6 +61,7 @@ apply_criterion_endpoint <- function(ep, analysis_data_container, fn_map) {
 #'
 #' @param ep A `data.table` containing endpoint data with applied endpoint
 #' criteria, typically the output from `apply_criterion_endpoint`.
+#' @param analysis_data_container data.table containing the analysis data.
 #' @param fn_map A `data.table` mapping endpoint definitions to by-strata
 #' criteria functions.
 #' @param type The type of criterion to apply, either

R/apply_stats.R

@@ -6,7 +6,7 @@
 #'
 #' @param ep A `data.table` containing prepared endpoint data for statistical
 #' analysis, typically the output from `prepare_for_stats`.
-#' @param fn_map A `data_table` mapping endpoint definitions to statistical
+#' @param analysis_data_container data.table containing the analysis data.
 #' functions.
 #' @param type The type of statistical function. Can be one of
 #' "stat_by_strata_by_trt", "stat_by_strata_across_trt", or "stat_across_strata_across_trt"

R/expand_endpoints.R

@@ -11,6 +11,7 @@
 #' @param ep A `data.table` containing endpoint definitions, where each row
 #' corresponds to a different endpoint and contains relevant attributes such
 #' as the endpoint name, type, and criteria.
+#' @param analysis_data_container data.table containing the analysis data.
 #' @return A `data.table` where each row corresponds to an expanded endpoint
 #' definition
 #' @export
@@ -20,16 +21,21 @@ expand_over_endpoints <- function(ep, analysis_data_container) {
  ep_with_data[, expand_specification := llist(define_expanded_ep(dat[[1]], group_by[[1]])),
  by = 1:nrow(ep_with_data)]
  ep_with_data[["dat"]] <- NULL
- ep_expanded <-
- ep_with_data %>% tidyr::unnest(col = expand_specification) %>% setDT()
 
- ep_expanded_2 <- add_missing_columns(ep_expanded)
- ep_expanded_2[, endpoint_id := add_ep_id(.SD, .BY), by =
- endpoint_spec_id]
+ # Expand by groups. If no grouping is present, then add empty group related columns
+ if(any(!is.na(ep_with_data$expand_specification))){
+ ep_exp <- ep_with_data %>% tidyr::unnest(col = expand_specification) %>% setDT()
+ }else{
+ ep_exp <- ep_with_data[, .SD, .SDcols = setdiff(names(ep_with_data), "expand_specification")]
+ ep_exp[, endpoint_group_filter := NA]
+ ep_exp[, endpoint_group_metadata := list()]
+ }
+
+ ep_exp[, endpoint_id := add_ep_id(.SD, .BY), by = endpoint_spec_id]
 
  # Complete endpoint labels by replacing keywords with values
- nm_set <- names(ep_expanded_2)
- ep_expanded_2[,endpoint_label_evaluated := apply(ep_expanded_2, 1, function(x){
+ nm_set <- names(ep_exp)
+ ep_exp[,endpoint_label_evaluated := apply(ep_exp, 1, function(x){
 
  xlab <- x[["endpoint_label"]]
 
@@ -61,12 +67,12 @@ expand_over_endpoints <- function(ep, analysis_data_container) {
  }
  return(xlab)
  })]
- ep_expanded_2[["endpoint_label"]] <- NULL
- setnames(ep_expanded_2, "endpoint_label_evaluated", "endpoint_label")
+ ep_exp[["endpoint_label"]] <- NULL
+ setnames(ep_exp, "endpoint_label_evaluated", "endpoint_label")
 
  keep <-
  setdiff(
- names(ep_expanded_2),
+ names(ep_exp),
  c(
  "data_prepare",
  "stat_by_strata_by_trt",
@@ -76,11 +82,12 @@ expand_over_endpoints <- function(ep, analysis_data_container) {
  "crit_by_strata_by_trt",
  "crit_by_strata_across_trt",
  "fn_type",
- "fn_hash"
+ "fn_hash",
+ "expand_specification"
  )
  )
 
-out <- ep_expanded_2[, .SD, .SDcols=keep]
+out <- ep_exp[, .SD, .SDcols=keep]
 setkey(out, key_analysis_data)
 out[]
 }
@@ -98,6 +105,8 @@ out[]
 #' @param group_by A list specifying the grouping for endpoints, where
 #' each element corresponds to a variable used for grouping endpoints and
 #' contains the levels for that grouping variable.
+#' @param forced_group_levels data.table (optional). Table with group levels 
+#' that must be included in the expansion, regardless of `group_by`.
 #' @param col_prefix A prefix used to create the names of the metadata and
 #' filter columns in the output `data.table`. Defaults to "endpoint_group".
 #'
@@ -223,25 +232,6 @@ add_ep_id <- function(x, grp) {
  ))]
 }
 
-
-add_missing_columns <- function(x){
- if(length(intersect(c("endpoint_group_filter", "empty", "endpoint_group_metadata"), names(x)))==2){
- return(x)
- }
- x1 <- copy(x)
- if(length(intersect(c("endpoint_group_filter"), names(x)))==0){
- x1[, endpoint_group_filter:=NA]
- }
- if(length(intersect(c("empty"), names(x)))==0){
- x1[, empty:=NA]
- }
- if(length(intersect(c("endpoint_group_metadata"), names(x)))==0){
- x1[, endpoint_group_metadata:=list()]
- }
-
- x1
-}
-
 #' Add forced group levels
 #'
 #' @description Expand the set of unique group levels of one grouping variables in a table containing all combinations of one or more grouping variables.

R/mk_endpoint_str.R

@@ -3,6 +3,7 @@
 #' @param study_metadata List. Metadata describing the clinical study.
 #' @param pop_var Character.
 #' @param pop_value Character.
+#' @param custom_pop_filter Character.
 #' @param treatment_var Character.
 #' @param treatment_refval Character.
 #' @param period_var Character.
@@ -14,18 +15,20 @@
 #' @param data_prepare List.
 #' @param stat_by_strata_by_trt List.
 #' @param stat_by_strata_across_trt List.
+#' @param stat_across_strata_across_trt List.
 #' @param crit_endpoint List.
 #' @param crit_by_strata_by_trt List.
 #' @param crit_by_strata_across_trt List.
 #' @param only_strata_with_events Boolean.
+#' @param env Environment.
 #'
 #' @return A data.table containing the endpoint specification.
 #' @export
 #'
 mk_endpoint_str <- function(study_metadata = NULL,
  pop_var = NULL,
  pop_value = NULL,
- custom_pop_filter=NA_character_,
+ custom_pop_filter = NA_character_,
  treatment_var = NULL,
  treatment_refval = NULL,
  period_var = NA_character_,

R/mk_filtered_endpoint_dt.R

@@ -1,44 +1,3 @@
-#' Filter adam data
-#'
-#' @param ep_unnest data.table. An unnested endpoint definition table
-#' @param adam_db data.table. A table containing the adam datasets associated
-#' with each data_prepare
-#'
-#' @return a data.table with the filtered adam data.
-#' @export
-#'
-join_adam <-
- function(ep,
- ep_fn_map,
- adam_db,
- filter_pop = TRUE,
- filter_period = TRUE,
- filter_trt = TRUE,
- filter_user_defined = TRUE) {
- checkmate::assert_data_table(ep)
- checkmate::assert_data_table(adam_db)
-
-
- ep_adam <-
- merge(ep, ep_fn_map[fn_type == "data_prepare"], by = "endpoint_spec_id")
-
- ep_adam <-
- merge(ep_adam,
- adam_db[, .(fn_hash, dat)],
- by = "fn_hash",
- all.x = TRUE,
- all.y = FALSE)
- # We no longer need to track the data generating (aka ADaM) functions.
- # Tracking it, in fact, might increase risk of triggering a unneccessary
- # re-run in targets if the fn hash changes without any data change
- keep_cols <-
- setdiff(names(ep_adam),
- c("fn_type", "fn", "fn_name", "fn_hash", "fn_callable"))
- ep_adam[, .SD, .SDcols = keep_cols]
-
-
- }
-
 #' Filter applying to a data.table
 #'
 #' @param adam_dt data.table::data.table

R/prepare_for_stats.R

@@ -9,6 +9,7 @@
 #' associated data, typically the output from `apply_criterion_by_strata`.
 #' @param fn_map A `data.table` mapping endpoint definitions to statistical
 #' functions.
+#' @param analysis_data_container data.table containing the analysis data.
 #' @param type A character string specifying the type of statistics for which
 #' the data is being prepared. Valid types are "stat_by_strata_by_trt",
 #' "stat_by_strata_across_trt", and "stat_across_strata_across_trt".
@@ -60,7 +61,7 @@ prepare_for_stats <- function(ep,
  nrow(fn_map[fn_type == type]) == 0 |
  (type == "stat_across_strata_across_trt" & !any(ep_accepted[[grouping_cols[[1]]]] != "TOTAL_"))
  ){
- return(data.table::data.table(SKIP_=TRUE))
+ return(data.table::data.table(SKIP_ = TRUE))
  }
 
  if (type %in% c("stat_by_strata_by_trt", "stat_by_strata_across_trt")) {
@@ -155,8 +156,8 @@ list_group_and_levels <- function(
  data,
  grouping_col
 ){
- l = list(data[, unique(get(grouping_col))])
- names(l) = grouping_col
+ l <- list(data[, unique(get(grouping_col))])
+ names(l) <- grouping_col
  return (l)
 }
 
@@ -169,6 +170,7 @@ list_group_and_levels <- function(
 #' @param ep A `data.table` containing endpoint data to be expanded.
 #' @param grouping_cols A character vector specifying the columns used for
 #' grouping in the expansion.
+#' @param analysis_data_container data.table containing the analysis data.
 #' @param data_col The name of the column in `ep` that contains the ADaM
 #' dataset.
 #' @param id_col The name of the column in `ep` that contains the unique
@@ -187,7 +189,7 @@ expand_ep_for_stats <- function(
  col_prefix
 ){
 
- name_expand_col = paste(col_prefix, "expand_spec", sep="_")
+ name_expand_col <- paste(col_prefix, "expand_spec", sep="_")
 
  ep[,"_i_" := .I]
  setkey(ep, key_analysis_data)
@@ -214,7 +216,7 @@ expand_ep_for_stats <- function(
 
  ep_exp[,"_i_":= .I]
  ep_exp_with_data <- ep_exp[analysis_data_container, nomatch = NULL]
- filter_col_name = paste(col_prefix, "filter", sep="_")
+ filter_col_name <- paste(col_prefix, "filter", sep="_")
  ep_exp_with_data[, cell_index := llist(create_flag(get(data_col)[[1]],
  singletons = c(get(filter_col_name)[[1]]))),
  by = "_i_"]
@@ -247,17 +249,17 @@ define_expansion_cell_from_data <- function(
  col_prefix
 ){
  if (is.character(grouping_cols)){
- grouping_cols = c(grouping_cols)
+ grouping_cols <- c(grouping_cols)
  }
  stopifnot(all(grouping_cols %in% names(row)))
 
  # Get the actual grouping variables
- grouping_col_values = row[, .SD, .SDcols=grouping_cols]
- grouping_var_list = vector(mode="list", length(grouping_col_values))
- names(grouping_var_list) = grouping_col_values
+ grouping_col_values <- row[, .SD, .SDcols=grouping_cols]
+ grouping_var_list <- vector(mode="list", length(grouping_col_values))
+ names(grouping_var_list) <- grouping_col_values
 
  if(row[["only_strata_with_events"]]){
- dat <-  row[,get(data_col)][[1]][row[["event_index"]]]
+ dat <- row[,get(data_col)][[1]][row[["event_index"]]]
  }else{
  dat <- row[,get(data_col)][[1]]
  }