Dumbell plot

Intro

I saw this post and was inspired. I wanted to experiment with dumbell plots and the fingertipsR package.

Libraries

library(pacman)
p_load(fingertipsR, ggplot2,
       dplyr, tidyr, ggalt,
       scales, stringr)

Get data

df <- fingertips_data(ProfileID = 130) #changing the profile id will allow you to perform the same task for other profiles

Filter

Filter for indicators with at least 2 years of data

df_twoyr <- df %>%
        group_by(IndicatorID) %>%
        summarise(num_years = n_distinct(Timeperiod)) %>%
        filter(num_years > 1)
df_yrs <- df %>%
        inner_join(df_twoyr, by = "IndicatorID") %>%
        select(IndicatorID, Timeperiod) %>%
        unique %>%
        group_by(IndicatorID) %>%
        arrange(Timeperiod) %>%
        top_n(-2) %>%
        mutate(yrid = c("Year1", "Year2"))
        
df_filt <- df %>%
        inner_join(df_yrs, by = c("IndicatorID", "Timeperiod")) %>%
        filter(AreaType == "County & UA") %>%
        mutate(IndicatorName = paste0(IndicatorName, " (",Sex, ", ",Age, ")")) %>%
        select(IndicatorID, IndicatorName, AreaName, yrid, Value) %>%
        unique() %>%
        spread(yrid, Value) %>%
        filter(!is.na(Year1),!is.na(Year2))

ind_change <- df_filt %>%
        mutate(increase = ifelse(Year2 - Year1 > 0, 1, 0),
               decrease = ifelse(Year2 - Year1 < 0, 1, 0)) %>%
        group_by(IndicatorID, IndicatorName) %>%
        summarise(num_increase = sum(increase),
                  num_decrease = sum(decrease))
        
most_increase <- ind_change %>%
        ungroup() %>%
        arrange(desc(num_increase)) %>%
        head(1) %>%
        select(IndicatorID, IndicatorName)

most_decrease <- ind_change %>%
        ungroup() %>%
        arrange(desc(num_decrease)) %>%
        head(1) %>%
        select(IndicatorID, IndicatorName)

Dumbell plots

inc <- df_filt %>%
        inner_join(most_increase, by = c("IndicatorID", "IndicatorName"))

inc$AreaName <- factor(inc$AreaName, levels=as.character(inc$AreaName)[order(inc$Year1)])

yr1 <- df_yrs %>%
        filter(IndicatorID %in% inc$IndicatorID) %>%
        head(1) %>%
        pull(Timeperiod)
yr2 <- df_yrs %>%
        filter(IndicatorID %in% inc$IndicatorID) %>%
        tail(1) %>%
        pull(Timeperiod)
ggplot(inc, aes(x=Year1/100, xend=Year2/100, y=AreaName, group=AreaName)) + 
        geom_dumbbell(color="#a3c4dc", 
                      size=0.75, 
                      colour_xend ="#0e668b") + 
        scale_x_continuous(label=percent) + 
        labs(x=NULL, 
             y=NULL, 
             title=str_wrap(unique(inc$IndicatorName), 80),
             subtitle=paste("Change:",yr1,"vs",yr2), 
             caption="Source: https://fingertips.phe.org.uk/") +
        theme(plot.title = element_text(size=rel(0.8), face="bold"),
              plot.background=element_rect(fill="#f7f7f7"),
              panel.background=element_rect(fill="#f7f7f7"),
              panel.grid.minor=element_blank(),
              panel.grid.major.y=element_blank(),
              panel.grid.major.x=element_line(),
              axis.ticks=element_blank(),
              legend.position="top",
              panel.border=element_blank(),
              axis.text.y = element_text(size = rel(0.7)))

dec <- df_filt %>%
        inner_join(most_decrease, by = c("IndicatorID", "IndicatorName"))

dec$AreaName <- factor(dec$AreaName, levels=as.character(dec$AreaName)[order(dec$Year1)])

yr1 <- df_yrs %>%
        filter(IndicatorID %in% dec$IndicatorID) %>%
        head(1) %>%
        pull(Timeperiod)
yr2 <- df_yrs %>%
        filter(IndicatorID %in% dec$IndicatorID) %>%
        tail(1) %>%
        pull(Timeperiod)
ggplot(dec, aes(x=Year1/100, xend=Year2/100, y=AreaName, group=AreaName)) + 
        geom_dumbbell(color="#a3c4dc", 
                      size=0.75, 
                      colour_xend = "#0e668b") + 
        scale_x_continuous(label=percent) + 
        labs(x=NULL, 
             y=NULL, 
             title=str_wrap(unique(dec$IndicatorName), 80),
             subtitle=paste("Change:",yr1,"vs",yr2), 
             caption="Source: https://fingertips.phe.org.uk/") +
        theme(plot.title = element_text(size=rel(0.8), face="bold"),
              plot.background=element_rect(fill="#f7f7f7"),
              panel.background=element_rect(fill="#f7f7f7"),
              panel.grid.minor=element_blank(),
              panel.grid.major.y=element_blank(),
              panel.grid.major.x=element_line(),
              axis.ticks=element_blank(),
              legend.position="top",
              panel.border=element_blank(),
              axis.text.y = element_text(size = rel(0.7)))