{} removed, multilevel variables lumped, more numerics grouped

SurgicalInformatics · Sep 15, 2023 · dd65652 · dd65652
1 parent a297de9
commit dd65652
Show file tree

Hide file tree

Showing 5 changed files with 118 additions and 36 deletions.
diff --git a/R/app_ui.R b/R/app_ui.R
@@ -18,7 +18,7 @@ app_ui <- function(request) {
 
       ),
       column(8,
-             p(paste("Preliminary data updated on", format(Sys.time(), format = "%d-%B %Y"))),
+             p(paste("Preliminary data updated on", updated_date, ":", nrow(appdata), "patient records")),
              mod_render_barplot_ui("render_barplot_ui_1")
       )
     )

diff --git a/data-raw/appdata.R b/data-raw/appdata.R
@@ -19,39 +19,103 @@ patient_data_orig %>%
   ggplot(aes(age_years)) +
   geom_histogram()
 
+labels_keep = extract_variable_label(patient_data_orig)
+
 appdata = patient_data_orig %>% 
   select(-redcap_data_access_group) %>% 
-  mutate(ALL = factor("ALL")) %>% 
-  mutate(age.groups = case_when(age_years < 18 ~ "Missing",
-                                between(age_years, 18, 30) ~ "18-30",
-                                between(age_years, 31, 50) ~ "31-50",
-                                between(age_years, 51, 70) ~ "51-70",
-                                between(age_years, 71, 120) ~ "71+",
-                                TRUE ~ "Missing") %>% 
-           ff_label("Age"),
-         admission_prior = parse_number(admission_prior),
-         admission_prior.groups = case_when(admission_prior == 0 ~ "None",
-                                            between(admission_prior, 1, 1) ~ "1",
-                                            between(admission_prior, 2, 3) ~ "2-3",
-                                            between(admission_prior, 5, 10) ~ "5-10",
-                                            between(admission_prior, 11, 10000) ~ "10+",
-                                            TRUE ~ "Missing") %>% 
-           fct_relevel("None", "1", "2-3", "5-10", "10+") %>% 
-           ff_label("Prior admissions"),
-         post30_los.groups = case_when(post30_los == 0 ~ "0",
-                                       between(post30_los, 1, 1) ~ "1",
-                                       between(post30_los, 2, 3) ~ "2-3",
-                                       between(post30_los, 5, 10) ~ "5-10",
-                                       between(post30_los, 11, 10000) ~ "10+",
-                                       TRUE ~ "Missing") %>%
-           fct_relevel("0", "1", "2-3", "5-10", "10+") %>% 
-           ff_label("Length of Stay (days)")
-         )
-
-# appdata %>% 
-#   #filter(admission_prior < 10) %>% 
-#   ggplot(aes(post30_los.groups)) +
-#   geom_bar()
+  # remove REDCAP internal varnames that are between {op_code}, etc (matrix variables only):
+  mutate(across(where(is_character), ~str_remove_all(., " \\s*\\{[^\\)]+\\}"))) %>% 
+  # remove HTML tags:
+  mutate(across(where(is_character), ~str_remove_all(., "<b>|</b>"))) %>% 
+  mutate(ALL = factor("ALL"), .after = 1) %>% 
+  mutate(
+    # age ----
+    age.groups = case_when(age_years < 18 ~ "Missing",
+                           between(age_years, 18, 30) ~ "18-30",
+                           between(age_years, 31, 50) ~ "31-50",
+                           between(age_years, 51, 70) ~ "51-70",
+                           between(age_years, 71, 120) ~ "71+",
+                           TRUE ~ "Missing") %>% 
+      ff_label("Age"),
+    # n admissions ----
+    admission_prior = parse_number(admission_prior),
+    admission_prior.groups = case_when(admission_prior == 0 ~ "None",
+                                       between(admission_prior, 1, 1) ~ "1",
+                                       between(admission_prior, 2, 3) ~ "2-3",
+                                       between(admission_prior, 5, 10) ~ "5-10",
+                                       between(admission_prior, 11, 10000) ~ "10+",
+                                       TRUE ~ "Missing") %>% 
+      fct_relevel("None", "1", "2-3", "5-10", "10+") %>% 
+      ff_label("Prior admissions"),
+    # LOS ----
+    post30_los.groups = case_when(post30_los == 0 ~ "0",
+                                  between(post30_los, 1, 1) ~ "1",
+                                  between(post30_los, 2, 3) ~ "2-3",
+                                  between(post30_los, 5, 10) ~ "5-10",
+                                  between(post30_los, 11, 10000) ~ "10+",
+                                  TRUE ~ "Missing") %>%
+      fct_relevel("0", "1", "2-3", "5-10", "10+") %>% 
+      ff_label("Length of Stay (days)"),
+    # symptom onset diagnosis ----
+    pre_symp_adm_day = parse_number(pre_symp_adm_day),
+    pre_symp_adm_day.groups = case_when(pre_symp_adm_day == 0 ~ "0 days",
+                                        between(pre_symp_adm_day, 1, 2) ~ "1-2 days",
+                                        between(pre_symp_adm_day, 3, 7) ~ "3-7 days",
+                                        between(pre_symp_adm_day, 8, 14) ~ "1-2 weeks",
+                                        between(pre_symp_adm_day, 15, 28) ~ "2-4 weeks",
+                                        between(pre_symp_adm_day, 29, 182) ~ "1-6 months",
+                                        between(pre_symp_adm_day, 182, 10000000) ~ "6+ months",
+                                        TRUE ~ "Missing") %>%
+      fct_relevel("0 days", "1-2 days", "3-7 days", "1-2 weeks", "2-4 weeks", "1-6 months", "6+ months") %>% 
+      ff_label("Symptom onset vs diagnosis (days)"),
+    # diagnosis vs decision to operate ----
+    pre_diag_dec_day.groups = case_when(pre_diag_dec_day == 0 ~ "0 days",
+                                        between(pre_diag_dec_day, 1, 2) ~ "1-2 days",
+                                        between(pre_diag_dec_day, 3, 7) ~ "3-7 days",
+                                        between(pre_diag_dec_day, 8, 14) ~ "1-2 weeks",
+                                        between(pre_diag_dec_day, 15, 28) ~ "2-4 weeks",
+                                        between(pre_diag_dec_day, 29, 182) ~ "1-6 months",
+                                        between(pre_diag_dec_day, 182, 10000000) ~ "6+ months",
+                                        TRUE ~ "Missing") %>%
+      fct_relevel("0 days", "1-2 days", "3-7 days", "1-2 weeks", "2-4 weeks", "1-6 months", "6+ months") %>% 
+      ff_label("Diagnosis vs decision to operate (days)"),
+    # decision to operate vs operation ----
+    pre_dec_op_day = parse_number(pre_dec_op_day),
+    pre_dec_op_day.groups = case_when(pre_dec_op_day == 0 ~ "0 days",
+                                      between(pre_dec_op_day, 1, 2) ~ "1-2 days",
+                                      between(pre_dec_op_day, 3, 7) ~ "3-7 days",
+                                      between(pre_dec_op_day, 8, 14) ~ "1-2 weeks",
+                                      between(pre_dec_op_day, 15, 28) ~ "2-4 weeks",
+                                      between(pre_dec_op_day, 29, 182) ~ "1-6 months",
+                                      between(pre_dec_op_day, 182, 10000000) ~ "6+ months",
+                                      TRUE ~ "Missing") %>%
+      fct_relevel("0 days", "1-2 days", "3-7 days", "1-2 weeks", "2-4 weeks", "1-6 months", "6+ months") %>% 
+      ff_label("Decision to operate vs operation (days)"),
+    # anaesthetic type ----
+    op_anaes.grouped = op_anaes %>% 
+      str_replace("Total Intravenous Volatile Anaesthetic \\(TIVA\\)", "TIVA") %>% 
+      str_remove(" \\(e.g., midazolam\\)") %>% 
+      fct_explicit_na("Missing") %>% 
+      fct_lump(8, other_level = "Other")
+    # end ----
+  ) %>% 
+  ff_relabel(labels_keep)
+
+
+
+appdata %>% 
+  count(op_contam, sort = TRUE)
+
+
+appdata %>% 
+  filter(pre_dec_op_day < 1000) %>% 
+  ggplot(aes(pre_dec_op_day)) +
+  geom_histogram(binwidth = 1)
+
+appdata %>%
+  #filter(admission_prior < 10) %>%
+  ggplot(aes(pre_dec_op_day.groups)) +
+  geom_bar()
 
 # %>% #select_if(is.factor) %>% 
 #mutate_if(is.factor, fct_explicit_na, na_level = "Missing") %>% 
@@ -67,13 +131,31 @@ appdata = patient_data_orig %>%
 # levels(appdata$diagnosis_timing) = str_trunc(levels(appdata$diagnosis_timing), width = 25)
 
 
+appdata = appdata %>%
+  select(-record_id, -age_years, -admission_prior, -post30_los,
+         -pre_symp_adm_day,
+         -pre_diag_dec_day,
+         -pre_dec_op_day,
+         -pt_comorbid,
+         -pre_img_finding,
+         -pre_img_finding_cbd,
+         -op_anaes)
+
+
+# pointblank::scan_data(appdata, sections = "OV")
+
+
 allvars = appdata %>%
-  select(-record_id, -age_years, -admission_prior, -post30_los) %>% 
   select(-contains("_day")) %>% 
   finalfit::extract_labels() %>%
   select(vname, vfill) %$%
   setNames(as.list(vname), vfill)
 
 
+
+
+updated_date = format(Sys.time(), format = "%d-%B %Y")
+
 usethis::use_data(appdata, overwrite = TRUE)
 usethis::use_data(allvars, overwrite = TRUE)
+usethis::use_data(updated_date, overwrite = TRUE)
diff --git a/rsconnect/argoshare.is.ed.ac.uk/rots/gecko_shinyviz.dcf b/rsconnect/argoshare.is.ed.ac.uk/rots/gecko_shinyviz.dcf
@@ -5,9 +5,9 @@ account: rots
 server: argoshare.is.ed.ac.uk
 hostUrl: https://argoshare.is.ed.ac.uk/__api__
 appId: 639
-bundleId: 3265
+bundleId: 3273
 url: https://argoshare.is.ed.ac.uk/gecko_shinyviz/
-when: 1694698060.84986
-lastSyncTime: 1694698060.84987
+when: 1694790034.70899
+lastSyncTime: 1694790034.709
 asMultiple: FALSE
 asStatic: FALSE
diff --git a/temp_histogram_ggplot.png b/temp_histogram_ggplot.png
diff --git a/temp_matrix_ggplot.png b/temp_matrix_ggplot.png