Fix merge conflicts

.github/workflows/pkgdown.yaml

@@ -0,0 +1,48 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+ push:
+ branches: [main, master]
+ pull_request:
+ branches: [main, master]
+ release:
+ types: [published]
+ workflow_dispatch:
+
+name: pkgdown
+
+jobs:
+ pkgdown:
+ runs-on: ubuntu-latest
+ # Only restrict concurrency for non-PR jobs
+ concurrency:
+ group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }}
+ env:
+ GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+ permissions:
+ contents: write
+ steps:
+ - uses: actions/checkout@v4
+
+ - uses: r-lib/actions/setup-pandoc@v2
+
+ - uses: r-lib/actions/setup-r@v2
+ with:
+ use-public-rspm: true
+
+ - uses: r-lib/actions/setup-r-dependencies@v2
+ with:
+ extra-packages: any::pkgdown, local::.
+ needs: website
+
+ - name: Build site
+ run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE)
+ shell: Rscript {0}
+
+ - name: Deploy to GitHub pages 🚀
+ if: github.event_name != 'pull_request'
+ uses: JamesIves/github-pages-deploy-action@v4.5.0
+ with:
+ clean: false
+ branch: gh-pages
+ folder: docs

DESCRIPTION

@@ -54,3 +54,4 @@ Config/testthat/edition: 3
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.1
+URL: https://hta-pharma.github.io/chef/

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,
@@ -65,11 +64,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/apply_criterion.R

@@ -177,7 +177,7 @@ unnest_ep_by_strata <- function(ep) {
  crit_accept_endpoint <-
  strata_var <- stratify_by <- NULL # To satisfy R CMD check
  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

@@ -39,7 +39,7 @@ apply_stats <-
  # produced
  nm <- names(ep)
  if (length(nm) <= 3 &&
-  nm[1] == "SKIP_") {
+ nm[1] == "SKIP_") {
  return(data.table(NULL))
  }
  type <- match.arg(type)
@@ -48,8 +48,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(
@@ -70,10 +69,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(
@@ -87,17 +84,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]](
@@ -117,5 +113,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
 }