Skip to content

Commit fa12372

Browse files
viv3ckjviv3ckj
authored
Merge pull request #88 from opensafely/viv3ckj/refactor-rmd-code
Viv3ckj/refactor code (part 2)
2 parents c3ca045 + 0eaba2f commit fa12372

File tree

7 files changed

+1155
-1214
lines changed

7 files changed

+1155
-1214
lines changed

‎lib/functions/create_tables.R

Lines changed: 131 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,131 @@
1+
# Function to create clinical pathways table
2+
create_clinical_pathways_table <- function(title) {
3+
data <- tibble(
4+
Condition = c(
5+
"Uncomplicated Urinary Tract Infection",
6+
"Shingles",
7+
"Impetigo",
8+
"Infected Insect Bites",
9+
"Acute Sore Throat",
10+
"Acute Sinusitis",
11+
"Acute Otitis Media"
12+
),
13+
Age = c(
14+
"16 to 64 years",
15+
"18 years and over",
16+
"1 year and over",
17+
"1 year and over",
18+
"5 years and over",
19+
"12 years and over",
20+
"1 to 17 years"
21+
),
22+
Sex = c(
23+
"Female",
24+
"Any",
25+
"Any",
26+
"Any",
27+
"Any",
28+
"Any",
29+
"Any"
30+
),
31+
Exclusions = c(
32+
"Pregnant individuals, urinary catheter, recurrent UTI (2 episodes in last 6 months, or 3 episodes in last 12 months)",
33+
"Pregnant individuals",
34+
"Bullous impetigo, recurrent impetigo (2 or more episodes in the same year), pregnant individuals under 16 years",
35+
"Pregnant individuals under 16 years",
36+
"Pregnant individuals under 16 years",
37+
"Immunosuppressed individuals, chronic sinusitis (symptoms lasting more than 12 weeks), pregnant individuals under 16 years",
38+
"Recurrent acute otitis media (3 or more episodes in 6 months or four or more episodes in 12 months), pregnant individuals under 16 years"
39+
)
40+
)
41+
42+
data %>%
43+
gt() %>%
44+
tab_header(
45+
title = title
46+
# subtitle = "Inclusion and exclusion criteria for clinical pathway/conditions"
47+
) %>%
48+
cols_label(
49+
Condition = "Condition",
50+
Age = "Age Range",
51+
Sex = "Sex",
52+
Exclusions = "Exclusions"
53+
) %>%
54+
tab_options(
55+
table.font.size = "medium",
56+
heading.title.font.size = "large",
57+
heading.subtitle.font.size = "small"
58+
) %>%
59+
tab_style(
60+
style = cell_text(weight = "bold"),
61+
locations = cells_column_labels(columns = everything())
62+
)
63+
}
64+
65+
# Function to create pharmacy first service codes table
66+
create_pf_service_codes_table <- function(title) {
67+
data <- tibble(
68+
codelist = c(
69+
"Community Pharmacist (CP) Consultation Service for minor illness (procedure)",
70+
"Pharmacy First service (qualifier value)"
71+
),
72+
code = c(
73+
"1577041000000109",
74+
"983341000000102"
75+
)
76+
)
77+
78+
data %>%
79+
gt() %>%
80+
tab_header(
81+
title = title,
82+
# subtitle = "Codelist descriptions and their respective SNOMED codes"
83+
) %>%
84+
cols_label(
85+
codelist = md("**Codelist Description**"),
86+
code = md("**SNOMED Code**")
87+
) %>%
88+
tab_options(
89+
table.font.size = "medium",
90+
heading.title.font.size = "large",
91+
heading.subtitle.font.size = "small"
92+
)
93+
}
94+
95+
create_clinical_conditions_codes_table <- function(title) {
96+
data <- tibble(
97+
condition = c(
98+
"Acute otitis media",
99+
"Herpes zoster",
100+
"Acute sinusitis",
101+
"Impetigo",
102+
"Infected insect bite",
103+
"Acute pharyngitis",
104+
"Uncomplicated urinary tract infection"
105+
),
106+
code = c(
107+
"3110003",
108+
"4740000",
109+
"15805002",
110+
"48277006",
111+
"262550002",
112+
"363746003",
113+
"1090711000000102"
114+
)
115+
)
116+
data %>%
117+
gt() %>%
118+
tab_header(
119+
title = title
120+
# subtitle = "Clinical conditions and their corresponding SNOMED codes"
121+
) %>%
122+
cols_label(
123+
condition = md("**Clinical Condition**"),
124+
code = md("**SNOMED Code**")
125+
) %>%
126+
tab_options(
127+
table.font.size = "medium",
128+
heading.title.font.size = "large",
129+
heading.subtitle.font.size = "small"
130+
)
131+
}

‎lib/functions/load_opensafely_outputs.R

Lines changed: 4 additions & 48 deletions
Original file line numberDiff line numberDiff line change
@@ -36,53 +36,9 @@ df_measures <- tidy_measures(
3636
pf_measures_groupby_dict = pf_measures_groupby_dict
3737
)
3838

39-
df_measures$ethnicity <- factor(
40-
df_measures$ethnicity,
41-
levels = c(
42-
"White",
43-
"Mixed",
44-
"Asian or Asian British",
45-
"Black or Black British",
46-
"Chinese or Other Ethnic Groups",
47-
"Missing"
48-
),
49-
ordered = TRUE
50-
)
51-
52-
df_measures$age_band <- factor(
53-
df_measures$age_band,
54-
levels = c(
55-
"0-19",
56-
"20-39",
57-
"40-59",
58-
"60-79",
59-
"80+",
60-
"Missing"
61-
),
62-
ordered = TRUE
63-
)
64-
65-
df_measures$region <- factor(
66-
df_measures$region,
67-
levels = c(
68-
"East",
69-
"East Midlands",
70-
"London",
71-
"North East",
72-
"North West",
73-
"South East",
74-
"South West",
75-
"West Midlands",
76-
"Yorkshire and The Humber",
77-
"Missing"
78-
),
79-
ordered = TRUE
80-
)
81-
82-
df_measures <- df_measures %>%
83-
mutate(sex = factor(sex,
84-
levels = c("female", "male"),
85-
labels = c("Female", "Male")
86-
))
39+
# str(df_measures$ethnicity)
40+
# str(df_measures$age_band)
41+
# str(df_measures$region)
42+
# str(df_measures$sex)
8743

8844
df_measures$age_band[is.na(df_measures$age_band)] <- "Missing"

‎lib/functions/plot_measures.R

Lines changed: 89 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -29,62 +29,98 @@ plot_measures <- function(
2929
facet_wrap = FALSE,
3030
facet_var = NULL,
3131
colour_var = NULL,
32+
shape_var = NULL,
33+
colour_palette = NULL,
34+
y_scale = NULL,
35+
scale_measure = NULL,
36+
shapes = NULL,
37+
date_breaks = "1 month",
3238
legend_position = "bottom") {
3339
# Test if all columns expected in output from generate measures exist
34-
expected_names <- c("measure", "interval_start", "interval_end", "ratio", "numerator", "denominator")
35-
missing_columns <- setdiff(expected_names, colnames(data))
40+
# expected_names <- c("measure", "interval_start", "interval_end", "ratio", "numerator", "denominator")
41+
# missing_columns <- setdiff(expected_names, colnames(data))
3642

37-
if (length(missing_columns) > 0) {
38-
stop("Data does not have expected column(s): ", paste(missing_columns, collapse = ", "), call. = FALSE)
39-
}
43+
# if (length(missing_columns) > 0) {
44+
# stop("Data does not have expected column(s): ", paste(missing_columns, collapse = ", "), call. = FALSE)
45+
# }
4046

4147
plot_tmp <- ggplot(
4248
data,
4349
aes(
4450
x = {{ select_interval_date }},
4551
y = {{ select_value }},
4652
colour = {{ colour_var }},
47-
group = {{ colour_var }}
53+
group = {{ colour_var }},
54+
shape = {{ colour_var }},
55+
fill = {{ colour_var }}
4856
)
4957
) +
50-
geom_point() +
51-
geom_line(alpha = .5) +
58+
geom_point(size = 2) +
59+
geom_line(alpha = .3) +
5260
geom_vline(
5361
xintercept = lubridate::as_date("2024-02-01"),
5462
linetype = "dotted",
5563
colour = "orange",
5664
linewidth = .7
5765
) +
5866
scale_x_date(
59-
date_breaks = "1 month",
67+
date_breaks = {{ date_breaks }},
6068
labels = scales::label_date_short()
6169
) +
6270
guides(
63-
color = guide_legend(nrow = guide_nrow)
71+
color = guide_legend(nrow = guide_nrow),
72+
shape = guide_legend(nrow = guide_nrow)
6473
) +
6574
labs(
6675
title = title,
6776
x = x_label,
6877
y = y_label,
6978
colour = guide_label,
79+
shape = NULL,
80+
fill = NULL
7081
) +
7182
theme(
7283
legend.position = legend_position,
73-
plot.title = element_text(hjust = 0.5)
84+
plot.title = element_text(hjust = 0.5),
85+
text = element_text(size = 14)
7486
)
7587

88+
# Change colour based on specified colour palette
89+
if (!is.null(colour_palette)) {
90+
if (length(colour_palette) == 1 && colour_palette == "plasma") {
91+
plot_tmp <- plot_tmp + scale_colour_viridis_d(option = "plasma", end = .75) +
92+
geom_line(size = 0.5) +
93+
geom_point(size = 2.5)
94+
} else {
95+
plot_tmp <- plot_tmp + scale_colour_manual(values = colour_palette)
96+
}
97+
} else {
98+
plot_tmp <- plot_tmp + scale_colour_viridis_d(end = .75)
99+
}
100+
101+
if (!is.null(shapes) && shapes == "condition_shapes") {
102+
plot_tmp <- plot_tmp + scale_shape_manual(values = condition_shapes)
103+
}
104+
76105
# Automatically change y scale depending selected value
77-
if (rlang::as_label(enquo(select_value)) %in% c("numerator", "denominator")) {
106+
scale_label <- rlang::as_label(enquo(scale_measure))
107+
if (is.null(scale_measure)) {
78108
plot_tmp <- plot_tmp + scale_y_continuous(
79109
limits = c(0, NA),
80110
labels = scales::label_number()
81111
)
82-
} else {
112+
} else if (scale_measure == "rate") {
83113
plot_tmp <- plot_tmp + scale_y_continuous(
84114
limits = c(0, NA),
85-
# scale = 1000 to calculate rate per 1000 people
86115
labels = scales::label_number(scale = 1000)
87116
)
117+
} else if (scale_measure == "percent") {
118+
plot_tmp <- plot_tmp + scale_y_continuous(labels = scales::percent)
119+
} else {
120+
plot_tmp <- plot_tmp + scale_y_continuous(
121+
limits = c(0, NA),
122+
labels = scales::label_number()
123+
)
88124
}
89125

90126
# Add facets if requested
@@ -94,12 +130,51 @@ plot_measures <- function(
94130
plot_tmp <- plot_tmp +
95131
facet_wrap(vars({{ facet_var }}), ncol = 2)
96132
}
133+
# Add y_scale to add option for free_y
134+
if (!is.null(y_scale) && y_scale == "free_y") {
135+
plot_tmp <- plot_tmp +
136+
facet_wrap(~source, scales = "free_y")
137+
}
97138

98139
plot_tmp
99140
}
100141

142+
set_patchwork_theme <- function(patchwork_figure) {
143+
patchwork_figure +
144+
plot_annotation(tag_levels = "A") +
145+
plot_layout(guides = "collect", widths = c(2, 1)) &
146+
theme(
147+
legend.position = "bottom",
148+
text = element_text(size = 15),
149+
strip.background = element_rect(size = 0),
150+
strip.text.x = element_text(size = 13, face = "bold")
151+
)
152+
}
153+
154+
save_figure <- function(figure, width = 10, height = 6) {
155+
# this uses the 'figure' argument as a string to later generate a filename
156+
figure_name <- deparse(substitute(figure))
157+
ggsave(
158+
filename = here("released_output", "results", "figures", paste(figure_name, "png",sep = ".")),
159+
figure,
160+
width = width, height = height
161+
)
162+
}
163+
101164
# Colour palettes
102165
gradient_palette <- c("#001F4D", "#0056B3", "#007BFF", "#66B3E2", "#A4D8E1", "grey")
103166
region_palette <- c("red", "navy", "#018701", "#ffa600ca", "purple", "brown", "#f4a5b2", "cyan", "green", "grey")
104167
ethnicity_palette <- c("#42db0188", "#0056B3", "#ff0000c2", "#a52a2a5a", "purple", "grey")
105168
sex_palette <- c("red", "blue")
169+
dark2_palette <- RColorBrewer::brewer.pal(n = 8, name = "Dark2")
170+
171+
# Custom shapes
172+
condition_shapes <- c(
173+
"Acute Sinusitis" = 15,
174+
"Infected Insect Bite" = 19,
175+
"UTI" = 4,
176+
"Acute Otitis Media" = 23,
177+
"Acute Pharyngitis" = 3,
178+
"Herpes Zoster" = 17,
179+
"Impetigo" = 8
180+
)

0 commit comments

Comments
 (0)