30DayChartChallenge2024

Source Code for All Contributed Charts

Information

Post | Feed | LinkedIn

30DayChartChallenge/Edition2024 (github.com)

Data

Charts in this challenge utilized a publicly available dataset that was extracted from the Aggregate Analysis of ClinicalTrials.gov (AACT) database (AACT Database | Clinical Trials Transformation Initiative (ctti-clinicaltrials.org)). This dataset, clinical_trials_fl, was generated by querying the AACT database using open-source tools like R, RStudio, DBI, PostgreSQL, the tidyverse suite, and gt. Specifically, this dataset represents all the clinical trials registered and completed within the state of Florida of the United States between 23MAR2014-23MAR2024 (10 years).

clinical_trials_fl <- readRDS("data/query_results_fl_clean_final.rds")
clinical_trials_fl_mesh <- readRDS("data/query_results_fl_clean_final_mesh.rds")
clinical_trials_fl_mesh_neo_joined <- readRDS("data/clinical_trials_fl_mesh_neo_joined.rds")

Comparisons

1. Part-to-whole

Part-to-whole charts display individual pieces or segments of data that make up a whole. Common examples are pie charts and stacked bar charts. These visualizations aid in understanding proportions or percentages that contribute to the whole (which is the case in this treemap example). For today’s example, we will visualize the proportion of conditions (using MeSH terms) that have been studied over the past 10 years in Florida. This visualization was inspired by the treemapping work of Yobanny Sámano: Treemap with annotations, labels and colors – the R Graph Gallery (r-graph-gallery.com).

packages <- c("tidyverse", "treemapify", "RColorBrewer")

if (any(!sapply(packages, requireNamespace, quietly = TRUE))) {
  install.packages(packages[!sapply(packages, requireNamespace, quietly = TRUE)])
}

library(tidyverse)
library(treemapify)
library(RColorBrewer)

#str(clinical_trials_fl)

# Step 1: Calculate frequencies for each mesh_term
clinical_trials_freq <- clinical_trials_fl_mesh %>%
  filter(!is.na(mesh_term)) %>%
  count(mesh_term) %>%
  mutate(total = sum(n), Proportion = n / total) %>%
  ungroup()

# Step 2: Select the top 30 mesh_terms based on frequency
top_25_mesh_terms <- clinical_trials_freq %>%
  arrange(desc(n)) %>%
  top_n(25, n) %>%
  mutate(label = paste(mesh_term, " (", n, ")", sep = "")) # Creating a new column 'label' for treemap labels

# Step 3: Generate the treemap - ggplot2 style
# Get colors from the "Oranges" palette
# You can adjust the number of colors based on your data
colors <- brewer.pal(9, "Oranges")

ggplot(top_25_mesh_terms, aes(area = n, fill = Proportion, label = label)) +
  geom_treemap() +
  geom_treemap_text(colour = "black", place = "centre", grow = TRUE) +
  scale_fill_gradientn(colours = colors) + # Using "Oranges" palette
  labs(
    title = "Top 25 MeSH Terms for Clinical Trials in Florida",
    subtitle = "MeSH Term (n)",
    caption = "Data Source: Clinical Trials Transformation Initiative (CTTI)."
  ) +
  theme_minimal() +
  theme(plot.background = element_rect(fill = "white"),
        text = element_text(color = "#1E1D23"),
        plot.title = element_text(size = 18, face = "bold"),
        plot.caption = element_text(size = 10, color = "black"))

ggsave("chart_1.png", width = 16, height = 9, dpi = 300)

2. Neo

Interestingly, yesterday’s analysis revealed that the most frequent MeSH term studied in Florida was neoplasms. Let’s see how many patients in Florida are receiving neoplasm treatment through clinical research studies. Importantly, a distinction should be made between interventional studies (i.e., those with a drug, device, or other treatment being administered), and observational studies (no treatment administered).

packages <- c("tidyverse", "RColorBrewer", "showtext")

if (any(!sapply(packages, requireNamespace, quietly = TRUE))) {
  install.packages(packages[!sapply(packages, requireNamespace, quietly = TRUE)])
}

library(tidyverse)
library(RColorBrewer)
library(showtext)

# A Florida-esque font from Google
font_add_google("Lobster", "lobster")
showtext_auto()

# Filter for the top MeSH term
clinical_trials_fl_mesh_neo <- clinical_trials_fl_mesh %>%
  filter(mesh_term == "Neoplasms") %>%
  group_by(mesh_term) %>%
  distinct(nct_id)

# Retrieve original features
clinical_trials_fl_distinct <- clinical_trials_fl %>%
  select(c(1, 4, 9, 10, 11, 12, 13, 16, 17, 18, 38, 39)) %>%
  distinct()

# Join the dataframes on nct_id
clinical_trials_fl_mesh_neo_joined <- clinical_trials_fl_distinct %>%
  inner_join(clinical_trials_fl_mesh_neo, by = "nct_id")

# Clean enrollment data
clinical_trials_fl_mesh_neo_joined <- clinical_trials_fl_mesh_neo_joined %>%
  mutate(
    enrollment_actual = if_else(enrollment_type == "Actual", enrollment, NA_integer_),
    enrollment_anticipated = if_else(enrollment_type == "Anticipated", enrollment, NA_integer_)
  )

# Clean study status
clinical_trials_fl_mesh_neo_joined <- clinical_trials_fl_mesh_neo_joined %>%
  mutate(overall_status = case_when(
    overall_status %in% c("Completed", "Approved for marketing") ~ "Completed",
    overall_status %in% c("Withdrawn", "Terminated", "Suspended", "No longer available") ~ "Not Completed",
    # Assuming any other status as "In Progress"
    TRUE ~ "In Progress"
  ))

clinical_trials_fl_mesh_neo_joined <- clinical_trials_fl_mesh_neo_joined %>%
  select(-c(enrollment, enrollment_type, enrollment_anticipated))

# Summarize total enrollment_actual by study_type
enrollment_by_study_type <- clinical_trials_fl_mesh_neo_joined %>%
  group_by(study_type) %>%
  summarise(total_enrollment = sum(enrollment_actual, na.rm = TRUE)) %>%
  ungroup() %>%
  arrange(desc(total_enrollment))

# Retrieve the Oranges palette
oranges_palette <- brewer.pal(n = 9, name = "Oranges")

# Lollipop chart with Oranges palette
p <- ggplot(enrollment_by_study_type, aes(x = reorder(study_type, total_enrollment), y = total_enrollment)) +
  geom_segment(aes(xend = study_type, yend = 0), color = oranges_palette[3], size = 1) + # Stems with a specific orange shade
  geom_point(aes(fill = total_enrollment), size = 5, color = "darkorange", shape = 21) + # Dots at the end of stems
  coord_flip() + # Flip coordinates to make it horizontal
  scale_y_continuous(labels = scales::comma, breaks = scales::pretty_breaks(n = 10)) +
  scale_fill_gradientn(colours = oranges_palette) + # Gradient fill for dots
  labs(title = "Total Neoplasm Enrollment by Study Type in Florida",
       x = "",
       y = "Total Enrollment", 
       caption = "Data Source: Clinical Trials Transformation Initiative (CTTI).") +
  theme_minimal(base_size = 14) +
  theme(panel.grid.major.y = element_line(color = "gray80", linetype = "dashed"),
        panel.grid.minor.y = element_blank(),
        plot.title = element_text(family = "lobster", face = "bold", size = 20, color = "darkorange"),
        axis.title.y = element_text(size = 16, face = "bold"),
        axis.text.x = element_text(angle = 45, hjust = 1, size = 14),
        legend.position = "none") +
  geom_label(aes(label = scales::comma(total_enrollment)), nudge_y = 30000, size = 4, label.padding = unit(0.25, "lines"),
             color = "black", fill = "#F0E442") # Adding labels to the points for direct readability

p

# Adjusting the plot with much larger text sizes for better readability when saving
p_adjusted_for_print <- p + 
  theme(plot.background = element_rect(fill = "white", color = NA),
        panel.background = element_rect(fill = "white", color = NA),
        text = element_text(size = 40), # Doubling base text size
        plot.title = element_text(family = "lobster", size = 95, face = "bold", color = "darkorange"), # Much larger title
        axis.title = element_text(size = 60), # Doubling axis titles for clarity
        axis.title.y = element_text(margin = margin(r = 40)), # Add right margin to y-axis title for better spacing
        axis.text.x = element_text(angle = 45, hjust = 1, size = 50), # Much larger x-axis text
        axis.text.y = element_text(size = 50), # Much larger y-axis text
        legend.title = element_text(size = 50), # Much larger legend title
        legend.text = element_text(size = 36), # Much larger legend text
        plot.margin = margin(40, 40, 40, 40)) + # Adjust plot margins for better framing
  geom_label(aes(label = scales::comma(total_enrollment)), nudge_y = 30000, size = 14, # Adjust label sizes
             label.padding = unit(0.5, "lines"), color = "black", fill = "#F0E442")

ggsave("chart_2.png", plot = p_adjusted_for_print, width = 16, height = 9, dpi = 300, bg = "white")

3. Makeover

The prompt for today was “Makeover.”

TLDR; I started programming with SAS and didn’t make my first R/ggplot2 plot until I was in my second semester of my master’s program for data science. That first “real” plot was in CAP 5990 Tools for Data Science at University of West Florida with Dr. Achraf Cohen as part of our final project. Here’s the prompt we were given:

Plot the boxplot of the departure delays vs the name of airlines where the destination is ATL airport. Solve this question using R and Python.

And here’s the original plot (in R/ggplot2), and the makeover from today (also in R/ggplot2):

packages <- c("tidyverse", "nycflights13")

if (any(!sapply(packages, requireNamespace, quietly = TRUE))) {
  install.packages(packages[!sapply(packages, requireNamespace, quietly = TRUE)])
}

library(tidyverse)
library(nycflights13)
library(showtext)
library(sysfonts)

# A Florida-esque font from Google
font_add_google("JetBrains Mono", "JetBrains Mono")
showtext_auto()

flights <- nycflights13::flights
airlines <- nycflights13::airlines

#?flights - arr_delay is in minutes; negatives are early arrivals

complete <- inner_join(flights, airlines)

atl_delays <- complete %>%
  select(name, dest, dep_delay) %>%
  drop_na() %>%
  filter(dest=="ATL") 

atl_delays_summary <- aggregate(atl_delays$dep_delay, list(atl_delays$name), FUN=mean)

atl_delays_summary <- atl_delays_summary %>% #Sorting by lowest to highest delay time, renaming and adding units to the dataframe
  arrange(x) %>%
  rename("Airline" = "Group.1") %>%
  rename("Departure  Delays (minutes)" = "x")

print(atl_delays_summary)

                      Airline Departure  Delays (minutes)
1           Endeavor Air Inc.                   0.9649123
2      Southwest Airlines Co.                   2.3448276
3                   Envoy Air                   9.3532028
4        Delta Air Lines Inc.                  10.4063365
5       United Air Lines Inc.                  15.7864078
6 AirTran Airways Corporation                  18.4456094
7    ExpressJet Airlines Inc.                  22.4026442

ggplot(atl_delays, aes(x=name, y=dep_delay)) + 
    geom_boxplot(fill="slateblue", alpha=0.2) + 
    xlab("Airline") + 
    ylab("Departure Delays for ATL (minutes)")

ggsave("firstplot.png")

#max(ATL_ddelays$dep_delay); FIX SCALE ISSUE IF TIME

Now that I know a little more about R and ggplot2, let’s give this plot a makeover. I even made a comment about fixing the scale issue, so let’s start with that and move forward!

str(atl_delays)

tibble [16,898 × 3] (S3: tbl_df/tbl/data.frame)
 $ name     : chr [1:16898] "Delta Air Lines Inc." "Envoy Air" "Delta Air Lines Inc." "Delta Air Lines Inc." ...
 $ dest     : chr [1:16898] "ATL" "ATL" "ATL" "ATL" ...
 $ dep_delay: num [1:16898] -6 0 -4 0 -2 -5 -3 4 -5 -4 ...

# Converting dep_delay from minutes to hours
atl_delays <- atl_delays %>%
  mutate(dep_delay_hours = dep_delay / 60)

ggplot(atl_delays, aes(x = name, y = dep_delay_hours)) +
  geom_violin(trim = FALSE) +
  geom_boxplot(width = 0.1, fill = "white") + # Adding a small boxplot inside for summary statistics
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  labs(x = "Airline Name", y = "Departure Delay (Hours)", title = "Departure Delay Distribution by Airline") +
  scale_y_continuous(labels = scales::unit_format(unit = "h", scale = 1))

p <- ggplot(atl_delays, aes(x = name, y = dep_delay_hours, fill = name)) +
  geom_violin(trim = FALSE) +
  geom_boxplot(width = 0.1, fill = "white") +
  scale_y_log10(labels = scales::math_format(10^.x)) + # Applying a logarithmic scale
  scale_fill_manual(values = c(
    "Endeavor Air Inc." = "#0033A0",  # Delta/Endeavor Navy Blue
    "Southwest Airlines Co." = "#3077A8",  # Southwest Canyon Blue
    "Envoy Air" = "#FA1D2F",  # Envoy/American Red
    "Delta Air Lines Inc." = "#0033A0",  # Delta Navy Blue
    "United Air Lines Inc." = "#1C56A5",  # United Rhapsody Blue
    "AirTran Airways Corporation" = "#008080",  # AirTran Teal
    "ExpressJet Airlines Inc." = "#005DAA"  # ExpressJet Blue
  )) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        axis.title.y = element_blank(),
        plot.title = element_text(face = "bold", family = "JetBrains Mono", size = 20),
        legend.position = "none") +
  labs(y = "Departure Delay (Log Hours)",
       title = "Explore the Skies: Departure Delay Patterns by Airline",
       caption = "Data Source: R package 'nycflights13'.") +
  coord_flip()

p

# Adjusting the plot with much larger text sizes for better readability when saving
p_adjusted_for_print <- p + 
  theme(plot.background = element_rect(fill = "white", color = NA),
        panel.background = element_rect(fill = "white", color = NA),
        text = element_text(size = 40), # Doubling base text size
        plot.title = element_text(family = "JetBrains Mono", size = 95, face = "bold"), # Much larger title
        axis.title = element_text(size = 60), # Doubling axis titles for clarity
        axis.title.y = element_blank(), # Add right margin to y-axis title for better spacing
        axis.text.x = element_text(angle = 45, hjust = 1, size = 50), # Much larger x-axis text
        axis.text.y = element_text(size = 50), # Much larger y-axis text
        legend.title = element_text(size = 50), # Much larger legend title
        plot.margin = margin(40, 40, 40, 40)) # Adjust plot margins for better framing

ggsave("chart_3.png", plot = p_adjusted_for_print, width = 18, height = 9, dpi = 300, bg = "white")