Doc_cleanup (#21)

* Move dev related texted out of main page and into dev page * Deleting articles that live in ramnog * Removing documentation that was moved to ramnog package * Apply stylr to whole package * Update README
hta-pharma · Mar 19, 2024 · 21074d1 · 21074d1
1 parent cc49b01
commit 21074d1
Show file tree

Hide file tree

Showing 95 changed files with 2,556 additions and 5,464 deletions.
diff --git a/.github/workflows/pkgdown.yaml b/.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
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -55,3 +55,4 @@ Config/testthat/edition: 3
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.1
+URL: https://hta-pharma.github.io/chef/
diff --git a/R/add_event_index.R b/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]
 }
diff --git a/R/add_id.R b/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[]

diff --git a/R/apply_criterion.R b/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()

diff --git a/R/apply_stats.R b/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]
-
   }
diff --git a/R/check_duplicate_functions.R b/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"
     )
   )
-
-
 }
diff --git a/R/construct_data_filter_logic.R b/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)
 }
diff --git a/R/eval_fn.R b/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
 }

diff --git a/R/evaluate_criteria.R b/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[])
 }