Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Examples for creating/improving functions #87

Closed
wants to merge 2 commits into from
Closed

Examples for creating/improving functions #87

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
5171e15
Add ethnicity recoding to `tidy_measures` function
milanwiedemann Dec 12, 2024
9ac86ac
Add function to create clinical pathways table
milanwiedemann Dec 12, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
64 changes: 64 additions & 0 deletions lib/functions/create_tables.R
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,64 @@
# Function to create clinical pathways table

create_clinical_pathways_table <- function() {
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 = "Table 1. Pharmacy First population criteria"
# 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())
)
}
16 changes: 4 additions & 12 deletions lib/functions/load_opensafely_outputs.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -29,25 +29,17 @@ if (Sys.getenv("OPENSAFELY_BACKEND") != "") {
)
}

# str(df_measures$ethnicity)

df_measures <- tidy_measures(
data = df_measures,
pf_measures_name_dict = pf_measures_name_dict,
pf_measures_name_mapping = pf_measures_name_mapping,
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
)
# str(df_measures$ethnicity)


df_measures$age_band <- factor(
df_measures$age_band,
Expand Down
13 changes: 12 additions & 1 deletion lib/functions/tidy_measures.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -33,6 +33,16 @@ pf_measures_groupby_dict <- list(
ethnicity = "Ethnicity"
)

pf_measures_ethnicity_list <- list(
"White",
"Mixed",
"Asian or Asian British",
"Black or Black British",
"Chinese or Other Ethnic Groups",
"Missing"
)


#' Tidy measures data
#'
#' Creates a tidier dataframe of measures data.
Expand All @@ -56,7 +66,8 @@ tidy_measures <- function(data, pf_measures_name_dict, pf_measures_name_mapping,
mutate(
measure_desc = recode(factor(measure), !!!pf_measures_name_mapping),
measure = recode(factor(measure), !!!pf_measures_name_dict),
group_by = recode(factor(group_by), !!!pf_measures_groupby_dict)
group_by = recode(factor(group_by), !!!pf_measures_groupby_dict),
ethnicity = factor(ethnicity, levels = pf_measures_ethnicity_list, labels = pf_measures_ethnicity_list)
)

data_tmp
Expand Down
67 changes: 6 additions & 61 deletions reports/pharmacy_first_report.Rmd
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -63,68 +63,13 @@ Currently, we have not yet applied any of the inclusion or exlusion citeria to r
This will initially help us to understand the underlying data.

```{r echo=FALSE, message=FALSE}
# Create clinical pathways dataframe
clinical_pathways_table <- data.frame(
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"
)
)

# Create clinical pathways table
clinical_pathways_table %>%
gt() %>%
tab_header(
title = "Table 1. Pharmacy First population criteria"
# 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())
)
tab_clinical_pathways <- create_clinical_pathways_table()

gtsave(
tab_clinical_pathways,
here("released_output", "results", "tables", "tab_clinical_pathways.png"),
)
```

### Codelists
Expand Down
Loading