Viv3ckj/refactor code (part 2)

lib/functions/create_tables.R

@@ -0,0 +1,131 @@
+# Function to create clinical pathways table
+create_clinical_pathways_table <- function(title) {
+  data <- tibble(
+    Condition = c(
+      "Uncomplicated Urinary Tract Infection",
+      "Shingles",
+      "Impetigo",
+      "Infected Insect Bites",
+      "Acute Sore Throat",
+      "Acute Sinusitis",
+      "Acute Otitis Media"
+    ),
+    Age = c(
+      "16 to 64 years",
+      "18 years and over",
+      "1 year and over",
+      "1 year and over",
+      "5 years and over",
+      "12 years and over",
+      "1 to 17 years"
+    ),
+    Sex = c(
+      "Female",
+      "Any",
+      "Any",
+      "Any",
+      "Any",
+      "Any",
+      "Any"
+    ),
+    Exclusions = c(
+      "Pregnant individuals, urinary catheter, recurrent UTI (2 episodes in last 6 months, or 3 episodes in last 12 months)",
+      "Pregnant individuals",
+      "Bullous impetigo, recurrent impetigo (2 or more episodes in the same year), pregnant individuals under 16 years",
+      "Pregnant individuals under 16 years",
+      "Pregnant individuals under 16 years",
+      "Immunosuppressed individuals, chronic sinusitis (symptoms lasting more than 12 weeks), pregnant individuals under 16 years",
+      "Recurrent acute otitis media (3 or more episodes in 6 months or four or more episodes in 12 months), pregnant individuals under 16 years"
+    )
+  )
+
+  data %>%
+    gt() %>%
+    tab_header(
+      title = title
+      # subtitle = "Inclusion and exclusion criteria for clinical pathway/conditions"
+    ) %>%
+    cols_label(
+      Condition = "Condition",
+      Age = "Age Range",
+      Sex = "Sex",
+      Exclusions = "Exclusions"
+    ) %>%
+    tab_options(
+      table.font.size = "medium",
+      heading.title.font.size = "large",
+      heading.subtitle.font.size = "small"
+    ) %>%
+    tab_style(
+      style = cell_text(weight = "bold"),
+      locations = cells_column_labels(columns = everything())
+    )
+}
+
+# Function to create pharmacy first service codes table
+create_pf_service_codes_table <- function(title) {
+  data <- tibble(
+    codelist = c(
+      "Community Pharmacist (CP) Consultation Service for minor illness (procedure)",
+      "Pharmacy First service (qualifier value)"
+    ),
+    code = c(
+      "1577041000000109",
+      "983341000000102"
+    )
+  )
+
+  data %>%
+    gt() %>%
+    tab_header(
+      title = title,
+      # subtitle = "Codelist descriptions and their respective SNOMED codes"
+    ) %>%
+    cols_label(
+      codelist = md("**Codelist Description**"),
+      code = md("**SNOMED Code**")
+    ) %>%
+    tab_options(
+      table.font.size = "medium",
+      heading.title.font.size = "large",
+      heading.subtitle.font.size = "small"
+    )
+}
+
+create_clinical_conditions_codes_table <- function(title) {
+  data <- tibble(
+    condition = c(
+      "Acute otitis media",
+      "Herpes zoster",
+      "Acute sinusitis",
+      "Impetigo",
+      "Infected insect bite",
+      "Acute pharyngitis",
+      "Uncomplicated urinary tract infection"
+    ),
+    code = c(
+      "3110003",
+      "4740000",
+      "15805002",
+      "48277006",
+      "262550002",
+      "363746003",
+      "1090711000000102"
+    )
+  )
+  data %>%
+    gt() %>%
+    tab_header(
+      title = title
+      # subtitle = "Clinical conditions and their corresponding SNOMED codes"
+    ) %>%
+    cols_label(
+      condition = md("**Clinical Condition**"),
+      code = md("**SNOMED Code**")
+    ) %>%
+    tab_options(
+      table.font.size = "medium",
+      heading.title.font.size = "large",
+      heading.subtitle.font.size = "small"
+    )
+}

lib/functions/load_opensafely_outputs.R

@@ -36,53 +36,9 @@ df_measures <- tidy_measures(
   pf_measures_groupby_dict = pf_measures_groupby_dict
 )
 
-df_measures$ethnicity <- factor(
-  df_measures$ethnicity,
-  levels = c(
-    "White",
-    "Mixed",
-    "Asian or Asian British",
-    "Black or Black British",
-    "Chinese or Other Ethnic Groups",
-    "Missing"
-  ),
-  ordered = TRUE
-)
-
-df_measures$age_band <- factor(
-  df_measures$age_band,
-  levels = c(
-    "0-19",
-    "20-39",
-    "40-59",
-    "60-79",
-    "80+",
-    "Missing"
-  ),
-  ordered = TRUE
-)
-
-df_measures$region <- factor(
-  df_measures$region,
-  levels = c(
-    "East",
-    "East Midlands",
-    "London",
-    "North East",
-    "North West",
-    "South East",
-    "South West",
-    "West Midlands",
-    "Yorkshire and The Humber",
-    "Missing"
-  ),
-  ordered = TRUE
-)
-
-df_measures <- df_measures %>%
-  mutate(sex = factor(sex,
-    levels = c("female", "male"),
-    labels = c("Female", "Male")
-  ))
+# str(df_measures$ethnicity)
+# str(df_measures$age_band)
+# str(df_measures$region)
+# str(df_measures$sex)
 
 df_measures$age_band[is.na(df_measures$age_band)] <- "Missing"

lib/functions/plot_measures.R

@@ -29,62 +29,98 @@ plot_measures <- function(
     facet_wrap = FALSE,
     facet_var = NULL,
     colour_var = NULL,
+    shape_var = NULL,
+    colour_palette = NULL,
+    y_scale = NULL,
+    scale_measure = NULL,
+    shapes = NULL,
+    date_breaks = "1 month",
     legend_position = "bottom") {
   # Test if all columns expected in output from generate measures exist
-  expected_names <- c("measure", "interval_start", "interval_end", "ratio", "numerator", "denominator")
-  missing_columns <- setdiff(expected_names, colnames(data))
+  # expected_names <- c("measure", "interval_start", "interval_end", "ratio", "numerator", "denominator")
+  # missing_columns <- setdiff(expected_names, colnames(data))
 
-  if (length(missing_columns) > 0) {
-    stop("Data does not have expected column(s): ", paste(missing_columns, collapse = ", "), call. = FALSE)
-  }
+  # if (length(missing_columns) > 0) {
+  #   stop("Data does not have expected column(s): ", paste(missing_columns, collapse = ", "), call. = FALSE)
+  # }
 
   plot_tmp <- ggplot(
     data,
     aes(
       x = {{ select_interval_date }},
       y = {{ select_value }},
       colour = {{ colour_var }},
-      group = {{ colour_var }}
+      group = {{ colour_var }},
+      shape = {{ colour_var }},
+      fill = {{ colour_var }}
     )
   ) +
-    geom_point() +
-    geom_line(alpha = .5) +
+    geom_point(size = 2) +
+    geom_line(alpha = .3) +
     geom_vline(
       xintercept = lubridate::as_date("2024-02-01"),
       linetype = "dotted",
       colour = "orange",
       linewidth = .7
     ) +
     scale_x_date(
-      date_breaks = "1 month",
+      date_breaks = {{ date_breaks }},
       labels = scales::label_date_short()
     ) +
     guides(
-      color = guide_legend(nrow = guide_nrow)
+      color = guide_legend(nrow = guide_nrow),
+      shape = guide_legend(nrow = guide_nrow)
     ) +
     labs(
       title = title,
       x = x_label,
       y = y_label,
       colour = guide_label,
+      shape = NULL,
+      fill = NULL
     ) +
     theme(
       legend.position = legend_position,
-      plot.title = element_text(hjust = 0.5)
+      plot.title = element_text(hjust = 0.5),
+      text = element_text(size = 14)
     )
 
+  # Change colour based on specified colour palette
+  if (!is.null(colour_palette)) {
+    if (length(colour_palette) == 1 && colour_palette == "plasma") {
+      plot_tmp <- plot_tmp + scale_colour_viridis_d(option = "plasma", end = .75) +
+        geom_line(size = 0.5) +
+        geom_point(size = 2.5)
+    } else {
+      plot_tmp <- plot_tmp + scale_colour_manual(values = colour_palette)
+    }
+  } else {
+    plot_tmp <- plot_tmp + scale_colour_viridis_d(end = .75)
+  }
+
+  if (!is.null(shapes) && shapes == "condition_shapes") {
+    plot_tmp <- plot_tmp + scale_shape_manual(values = condition_shapes)
+  }
+
   # Automatically change y scale depending selected value
-  if (rlang::as_label(enquo(select_value)) %in% c("numerator", "denominator")) {
+  scale_label <- rlang::as_label(enquo(scale_measure))
+  if (is.null(scale_measure)) {
     plot_tmp <- plot_tmp + scale_y_continuous(
       limits = c(0, NA),
       labels = scales::label_number()
     )
-  } else {
+  } else if (scale_measure == "rate") {
     plot_tmp <- plot_tmp + scale_y_continuous(
       limits = c(0, NA),
-      # scale = 1000 to calculate rate per 1000 people
       labels = scales::label_number(scale = 1000)
     )
+  } else if (scale_measure == "percent") {
+    plot_tmp <- plot_tmp + scale_y_continuous(labels = scales::percent)
+  } else {
+    plot_tmp <- plot_tmp + scale_y_continuous(
+      limits = c(0, NA),
+      labels = scales::label_number()
+    )
   }
 
   # Add facets if requested
@@ -94,12 +130,51 @@ plot_measures <- function(
     plot_tmp <- plot_tmp +
       facet_wrap(vars({{ facet_var }}), ncol = 2)
   }
+  # Add y_scale to add option for free_y
+  if (!is.null(y_scale) && y_scale == "free_y") {
+    plot_tmp <- plot_tmp +
+      facet_wrap(~source, scales = "free_y")
+  }
 
   plot_tmp
 }
 
+set_patchwork_theme <- function(patchwork_figure) {
+  patchwork_figure +
+    plot_annotation(tag_levels = "A") +
+    plot_layout(guides = "collect", widths = c(2, 1)) &
+    theme(
+      legend.position = "bottom",
+      text = element_text(size = 15),
+      strip.background = element_rect(size = 0),
+      strip.text.x = element_text(size = 13, face = "bold")
+    )
+}
+
+save_figure <- function(figure, width = 10, height = 6) {
+  # this uses the 'figure' argument as a string to later generate a filename
+  figure_name <- deparse(substitute(figure))
+  ggsave(
+    filename = here("released_output", "results", "figures", paste(figure_name, "png",sep = ".")),
+    figure,
+    width = width, height = height
+  )
+}
+
 # Colour palettes
 gradient_palette <- c("#001F4D", "#0056B3", "#007BFF", "#66B3E2", "#A4D8E1", "grey")
 region_palette <- c("red", "navy", "#018701", "#ffa600ca", "purple", "brown", "#f4a5b2", "cyan", "green", "grey")
 ethnicity_palette <- c("#42db0188", "#0056B3", "#ff0000c2", "#a52a2a5a", "purple", "grey")
 sex_palette <- c("red", "blue")
+dark2_palette <- RColorBrewer::brewer.pal(n = 8, name = "Dark2")
+
+# Custom shapes
+condition_shapes <- c(
+  "Acute Sinusitis" = 15,
+  "Infected Insect Bite" = 19,
+  "UTI" = 4,
+  "Acute Otitis Media" = 23,
+  "Acute Pharyngitis" = 3,
+  "Herpes Zoster" = 17,
+  "Impetigo" = 8
+)