+
+
+Code
+# PROJECT SETUP
+
+# #################### Libraries #################### #
+library(here)
+library(tidyverse)
+library(dbplyr, warn.conflicts = FALSE)
+library(rlang, warn.conflicts = FALSE)
+library(odbc)
+
+
+# #################### Constants #################### #
+CONFIG_PATH <- "config/db_config.yml"
+
+OMOP_TABLES_DIR <- "res/tables/"
+OMOP_COLUMNS_DIR <- "res/columns/"
+
+INPUT_TABLES_FILE <- "clinical.txt"
+OUTPUT_PATH <- "out/concept_frequency.csv"
+
+
+# #################### Functions: Data #################### #
+
+# Higher order function to conditionally apply a pipe
+# Note that the cond is not vectorised (should be a single logical)
+pipe_if <- function(df, cond, func) {
+ if (cond) func(df)
+ else df
+}
+
+# Load the list of OMOP clinical tables
+load_table_list <- function(filename) {
+ read_delim(
+ file = here(paste0(OMOP_TABLES_DIR, filename)),
+ delim = ",",
+ col_names = FALSE,
+ col_types = "c",
+ show_col_types = FALSE)$X1 |>
+ map(function(t) { tolower(t) })
+}
+
+# Load OMOP column specs for the given table
+load_column_metadata <- function(table) {
+ read_csv(
+ file = here(paste0(OMOP_COLUMNS_DIR, table, "_column_spec.csv")),
+ col_types = "cIlcccllcIc",
+ show_col_types = FALSE)
+}
+
+# Load OMOP column specs extracting Concept columns
+load_concept_columns <- function(table) {
+ OMOP_VER <- 53
+ OMOP_CONCEPT_TYPE <- "concept"
+
+ load_column_metadata(table) |>
+ filter(version <= OMOP_VER, type == OMOP_CONCEPT_TYPE) |>
+ pull(column)
+}
+
+# Debugging output
+#
+#clinical_tables <- load_table_list("clinical.txt")
+#clinical_tables
+#
+# concepts_by_table <- clinical_tables |>
+# # keep(function(t) { t == "person" || t == "death" }) |>
+# map(function(t) { l <- list(); l[[t]] <- load_concept_columns(t); l }) |>
+# list_flatten()
+# concepts_by_table
+# map(ls(concepts_by_table), function(t) { list(t, concepts_by_table[[t]] |> as.list()) })
+
+
+# Load DB configuration
+db_load_config <- function(filepath) {
+ config = config::get(file = here(filepath))
+}
+
+# Connect to a database from the given config
+db_connect <- function(config) {
+ # Load DB connection
+ dbConnect(
+ odbc(),
+ driver = as.character(config["odbc_driver"]),
+ database = as.character(config["odbc_database"]),
+ server = as.character(config["odbc_server"]),
+ port = as.integer(config["odbc_port"]),
+ uid = as.character(config["odbc_uid"]),
+ pwd = as.character(config["odbc_pwd"]))
+}
+
+# Load table from DB
+db_omop_table <- function(tablename, config, conn, cols=NULL) {
+ tbl(conn, in_schema(as.character(config["odbc_schema"]), tablename)) |>
+ pipe_if(! missing(cols), \(df) df |> select(all_of(cols))) |>
+ # head() |> # Head of all tables
+ # pipe_if(tablename != "concept", \(df) df |> head()) |> # Head of non Concept tables
+ collect()
+}
+
+# Enrich given data frame with the count by column, and include table and column names as metadata
+count_with_metadata <- function(df, tablename, colname) {
+ df |>
+ rename(concept = all_of({{colname}})) |>
+ count(concept, name="count") |>
+ mutate(
+ table=tablename,
+ column=colname,
+ .before=concept)
+}
+
+# Enrich data frame adding concept names
+join_with_concept <- function(df, concepts_df) {
+ df |>
+ left_join(
+ concepts_df,
+ by=join_by(concept == concept_id))
+}
+
+
+# #################### Functions: Plots #################### #
+
+# Arranges rows by "count" and update factor levels (for the arrangement to be respected by plots)
+arrange_by_count <- function(.df) {
+ .df |>
+ # Arrange by count, which sorts the dataframe but NOT the factor levels
+ arrange(desc(count)) |>
+ # Update the factor levels
+ mutate(concept_name=fct_reorder(concept_name, count))
+}
+
+# Groups rows by concept name, summarising the counts
+group_by_name <- function(.df) {
+ .df |>
+ group_by(concept_name) |>
+ summarise(count=sum(count))
+}
+
+# Returns a vector of N colours (N <= 12) to use as palette
+get_palette <- function(n) {
+ c("#009cdb", "#00a3c0", "#00a599", "#33a46f", "#6e9e4c", "#9a933c",
+ "#bd8445", "#d57562", "#db6d8a", "#cc72b2", "#a881d3", "#7090e2") |>
+ head(n)
+}
+
+# Returns a bar plot of frequency counts
+freq_bar_plot <- function(.df, head=30, title="", fill="#999999") {
+ .df |>
+ group_by_name() |>
+ arrange_by_count() |>
+ head(head) |>
+ ggplot(aes(x=concept_name, y=count)) +
+ geom_bar(stat="identity", fill=fill, width=.6) +
+ coord_flip() +
+ xlab("") +
+ scale_x_discrete(label=function(x) { stringr::str_trunc(x, 50) }) +
+ ggtitle(label=title) +
+ theme_bw()
+}
+
+# Returns a pie plot of concept distribution with percentages
+dist_pie_plot <- function(.df, head=10, title="", fill=c(), border="white") {
+ .df |>
+ group_by_name() |>
+ arrange_by_count() |>
+ head(head) |>
+ # Calculate count %
+ mutate(percent = round(count / sum(.df$count) * 100)) |>
+ # Plot
+ ggplot(aes(x="", y=count, fill=concept_name)) +
+ geom_bar(stat="identity", width=1, colour="white") +
+ coord_polar("y", start=0) +
+ # Remove background, grid, numeric labels
+ theme_void() +
+ # Embed count %
+ geom_text(
+ aes(label=paste0(percent, "%")),
+ position=position_stack(vjust=0.5),
+ colour="white", fontface = "bold", size=6) +
+ # Title and colour
+ ggtitle(label=title) +
+ scale_fill_manual(values=fill)
+}
+
+
+
+
+
+