Sensitivity analysis ex consultation0

analysis/create_project_actions.R

@@ -159,8 +159,60 @@ generate_input_clean <- function(cohort) {
         glue("generate_merged_{cohort}")
       ),
       highly_sensitive = list(
-        cohort_clean = glue("output/dataset_clean/input_{cohort}_clean.rds"),
-        icc_input = glue("output/dataset_clean/icc_input-{cohort}.dta")
+        cohort_clean = glue(
+          "output/dataset_clean/input_{cohort}_clean.rds"
+        ),
+        icc_input = glue(
+          "output/dataset_clean/icc_input-{cohort}.dta"
+        )
+      ),
+      moderately_sensitive = list(
+        flow = glue(
+          "output/dataset_clean/flow-cohort_{cohort}.csv"
+        ),
+        flow_midpoint6 = glue(
+          "output/dataset_clean/flow-cohort_{cohort}-midpoint6.csv"
+        )
+      )
+    )
+  )
+}
+
+# Generate cleaned sensitivity input - sensitivity consultation
+generate_input_sensitivity <- function(cohort, sensitivity_type = "sensitivity_consultation") {
+  splice(
+    comment(glue(
+      "Generate cleaned input dataset - {sensitivity_type} - {cohort}"
+    )),
+    action(
+      name = glue(
+        "generate_input_{cohort}_clean_{sensitivity_type}"
+      ),
+      run = glue(
+        "r:v2 analysis/dataset_clean_sensitivity/dataset_clean_sensitivity.R {cohort} {sensitivity_type}"
+      ),
+      needs = list(
+        glue("generate_input_{cohort}_clean")
+      ),
+      highly_sensitive = list(
+        cohort_clean_sensitivity = glue(
+          "output/dataset_clean/{sensitivity_type}/",
+          "input_{cohort}_clean.rds"
+        ),
+        icc_input_sensitivity = glue(
+          "output/dataset_clean/{sensitivity_type}/",
+          "icc_input-{cohort}.dta"
+        )
+      ),
+      moderately_sensitive = list(
+        flow_sensitivity = glue(
+          "output/dataset_clean/{sensitivity_type}/",
+          "flow-cohort_{cohort}.csv"
+        ),
+        flow_sensitivity_midpoint6 = glue(
+          "output/dataset_clean/{sensitivity_type}/",
+          "flow-cohort_{cohort}-midpoint6.csv"
+        )
       )
     )
   )
@@ -184,59 +236,112 @@ generate_icc_outcome <- function(cohort) {
 }
 
 # Generate input for trajectory outcome graphs
-generate_input_trajectory_outcomes <- function() {
+generate_input_trajectory_outcomes <- function(sensitivity_type = "main") {
+  output_suffix <- if (sensitivity_type == "main") {
+    ""
+  } else {
+    paste0("_", sensitivity_type)
+  }
+
+  input_actions <- if (sensitivity_type == "main") {
+    as.list(glue("generate_input_{cohorts_all}_clean"))
+  } else {
+    as.list(glue(
+      "generate_input_{cohorts_all}_clean_{sensitivity_type}"
+    ))
+  }
+
+  action_name <- if (sensitivity_type == "main") {
+    "generate_input_trajectory_outcomes"
+  } else {
+    glue("generate_input_trajectory_outcomes_{sensitivity_type}")
+  }
+
   splice(
-    comment("Generate input for trajectory outcome graphs"),
+    comment(glue("Generate input for trajectory outcome graphs - {sensitivity_type}")),
     action(
-      name = "generate_input_trajectory_outcomes",
-      run = "r:v2 analysis/graphs/trajectory_outcomes.R",
-      needs = as.list(glue("generate_input_{cohorts_all}_clean")),
+      name = action_name,
+      run = glue("r:v2 analysis/graphs/trajectory_outcomes.R {sensitivity_type}"),
+      needs = input_actions,
       moderately_sensitive = list(
         input_trajectory_outcomes =
-          "output/graphs/input_trajectory_outcomes.csv"
+          glue("output/graphs/input_trajectory_outcomes{output_suffix}.csv")
       )
     )
   )
 }
 
-# Generate Table 1
-generate_table1 <- function(cohort) {
+# Generate Table 1 -------------------------------------------------------------
+generate_table1 <- function(cohort, sensitivity_type = "main") {
+  output_suffix <- if (sensitivity_type == "main") {
+    ""
+  } else {
+    paste0("_", sensitivity_type)
+  }
+
+  input_action <- if (sensitivity_type == "main") {
+    glue("generate_input_{cohort}_clean")
+  } else {
+    glue("generate_input_{cohort}_clean_{sensitivity_type}")
+  }
+
   splice(
-    comment(glue("Generate Table 1 summary statistics - {cohort}")),
+    comment(glue(
+      "Generate Table 1 summary statistics - {cohort} - {sensitivity_type}"
+    )),
     action(
-      name = glue("generate_table1_{cohort}"),
-      run = glue("r:v2 analysis/table1/table1.R {cohort}"),
+      name = glue("generate_table1_{cohort}_{sensitivity_type}"),
+      run = glue(
+        "r:v2 analysis/table1/table1.R {cohort} {sensitivity_type}"
+      ),
       needs = list(
-        glue("generate_input_{cohort}_clean")
+        input_action
       ),
       moderately_sensitive = list(
-        table1_midpoint6_TRUE = glue(
-          "output/table1/table1-cohort_{cohort}-midpoint6.csv"
+        table1 = glue(
+          "output/table1/table1-cohort_{cohort}{output_suffix}.csv"
         ),
-        table1_midpoint6_FALSE = glue(
-          "output/table1/table1-cohort_{cohort}.csv"
+        table1_midpoint6 = glue(
+          "output/table1/table1-cohort_{cohort}{output_suffix}-midpoint6.csv"
         )
       )
     )
   )
 }
 
-# Generate Table 2
-generate_table2 <- function(cohort) {
+
+# Generate Table 2 -------------------------------------------------------------
+generate_table2 <- function(cohort, sensitivity_type = "main") {
+  output_suffix <- if (sensitivity_type == "main") {
+    ""
+  } else {
+    paste0("_", sensitivity_type)
+  }
+
+  input_action <- if (sensitivity_type == "main") {
+    glue("generate_input_{cohort}_clean")
+  } else {
+    glue("generate_input_{cohort}_clean_{sensitivity_type}")
+  }
+
   splice(
-    comment(glue("Generate Table 2 summary statistics - {cohort}")),
+    comment(glue(
+      "Generate Table 2 summary statistics - {cohort} - {sensitivity_type}"
+    )),
     action(
-      name = glue("generate_table2_{cohort}"),
-      run = glue("r:v2 analysis/table2/table2.R {cohort}"),
+      name = glue("generate_table2_{cohort}_{sensitivity_type}"),
+      run = glue(
+        "r:v2 analysis/table2/table2.R {cohort} {sensitivity_type}"
+      ),
       needs = list(
-        glue("generate_input_{cohort}_clean")
+        input_action
       ),
       moderately_sensitive = list(
-        table2_midpoint6_TRUE = glue(
-          "output/table2/table2-cohort_{cohort}-midpoint6.csv"
+        table2 = glue(
+          "output/table2/table2-cohort_{cohort}{output_suffix}.csv"
         ),
-        table2_midpoint6_FALSE = glue(
-          "output/table2/table2-cohort_{cohort}.csv"
+        table2_midpoint6 = glue(
+          "output/table2/table2-cohort_{cohort}{output_suffix}-midpoint6.csv"
         )
       )
     )
@@ -579,8 +684,15 @@ for (cohort in cohorts_all) {
   actions_list <- c(actions_list, generate_table1(cohort))
   actions_list <- c(actions_list, generate_table2(cohort))
   actions_list <- c(actions_list, generate_icc_outcome(cohort))
+  actions_list <- c(actions_list, generate_input_sensitivity(cohort, "sensitivity_consultation"))
+  actions_list <- c(actions_list, generate_table1(cohort, "sensitivity_consultation"))
+  actions_list <- c(actions_list, generate_table2(cohort, "sensitivity_consultation"))
 }
-actions_list <- c(actions_list, generate_input_trajectory_outcomes())
+actions_list <- c(
+  actions_list,
+  generate_input_trajectory_outcomes("main"),
+  generate_input_trajectory_outcomes("sensitivity_consultation")
+)
 
 # Run models for all active analyses ----------------------------------------------
 actions_list <- c(

analysis/dataset_clean/dataset_clean.R

@@ -39,9 +39,6 @@ if (length(args) == 0) {
   cohort <- args[[1]]
 }
 
-# Flag to control whether inclusion/exclusion criteria are applied
-apply_inex <- TRUE # Set to TRUE for real run, FALSE for testing
-
 # Preprocess patient-level data --------------------------------------------------------------
 print("Preprocess patient-level data")
 input <- preprocess_patient(cohort)
@@ -99,23 +96,68 @@ print("Apply redaction")
 input <- redact(input)
 message("Redaction applied")
 
+# Initialise flow table ------------------------------------------------------
+flow <- data.frame(
+  Description = "Input before practice exclusions",
+  N = n_distinct(input$practice_id),
+  Excluded = NA_integer_,
+  stringsAsFactors = FALSE
+)
+
 # Apply inclusion/exclusion criteria ----------------------------------------
 print("Apply inclusion/exclusion criteria")
 
-if (apply_inex) {
-  input <- inex_practice(input)
-  message(paste0(
-    "Practice summary dataset AFTER applying ",
-    "inclusion/exclusion criteria has N = ",
-    nrow(input),
-    " rows"
-  ))
-} else {
-  message(
-    "Skipping inclusion/exclusion (apply_inex = FALSE) using full",
-    " dataset for testing."
-  )
-}
+inex_results <- inex_practice(
+  input,
+  flow,
+  exclude_small_practices = TRUE,
+  exclude_unknown_region = TRUE
+)
+
+input <- inex_results$input
+
+# Save flow data after inclusion/exclusion criteria ----------------------------
+print("Saving flow data after inclusion/exclusion criteria")
+
+flow <- inex_results$flow
+flow$N <- as.numeric(flow$N)
+
+# Replace Excluded with removed, following the previous project's format
+flow$Excluded <- NULL
+flow$removed <- lag(flow$N, default = first(flow$N)) - flow$N
+
+write.csv(
+  flow,
+  file = paste0(dataclean_dir, "flow-cohort_", cohort, ".csv"),
+  row.names = FALSE
+)
+
+# Apply midpoint-6 rounding ----------------------------------------------------
+print("Applying midpoint-6 rounding to flow data")
+
+flow_midpoint6 <- flow
+flow_midpoint6$removed <- NULL
+
+flow_midpoint6$N_midpoint6 <- roundmid_num(
+  flow_midpoint6$N,
+  to = 6
+)
+
+flow_midpoint6$removed_derived <- lag(
+  flow_midpoint6$N_midpoint6,
+  default = first(flow_midpoint6$N_midpoint6)
+) - flow_midpoint6$N_midpoint6
+
+flow_midpoint6$N <- NULL
+
+# Save rounded flow data -------------------------------------------------------
+print("Saving midpoint-6 rounded flow data")
+
+write.csv(
+  flow_midpoint6,
+  file = paste0(dataclean_dir, "flow-cohort_", cohort, "-midpoint6.csv"),
+  row.names = FALSE
+)
 
 # Restrict to relevant variables only ----------------------------------------
 print("Restrict to relevant variables only")

analysis/dataset_clean/fn-inex_practice.R

@@ -1,26 +1,51 @@
 # Function to apply inclusion/exclusion criteria
 
 inex_practice <- function(
-    input
+    input,
+    flow,
+    exclude_small_practices = TRUE,
+    exclude_unknown_region = TRUE
 ) {
-    # Remove practices with <1000 patients ----------------------------------------
+  # Main analysis: exclude practices with <1000 patients or missing list size.
+  n_before <- n_distinct(input$practice_id)
 
-    print("Remove practices with <1000 patients")
+  if (exclude_small_practices) {
+    input <- filter(input, list_size >= 1000)
+    description <- "Main analysis: exclude list size <1000 or missing"
+  } else {
+    description <- "Main analysis: list-size exclusion skipped"
+  }
 
-    n_before <- nrow(input)
+  n_after <- n_distinct(input$practice_id)
 
-    input <- input %>%
-        filter(list_size >= 1000)
+  flow[nrow(flow) + 1, ] <- list(
+    description,
+    n_after,
+    n_before - n_after
+  )
+  print(flow[nrow(flow), ])
 
-    n_after <- nrow(input)
+  n_before <- n_distinct(input$practice_id)
 
-    n_removed <- n_before - n_after
+  if (exclude_unknown_region) {
+    input <- filter(input, !is.na(practice_region))
+    description <- "Main analysis: exclude practices with unknown region"
+  } else {
+    description <- "Main analysis: unknown region exclusion skipped"
+  }
 
-    message(paste0("Number of practices with <1000 patients: ", n_removed))
-    message(paste0(
-        "Practice summary dataset after removing small practices has N = ",
-        n_after,
-        " rows"
-    ))
-    return(input)
+  n_after <- n_distinct(input$practice_id)
+
+  flow[nrow(flow) + 1, ] <- list(
+    description,
+    n_after,
+    n_before - n_after
+  )
+  print(flow[nrow(flow), ])
+
+
+  return(list(
+    input = input,
+    flow = flow
+  ))
 }