Click the Original, Code and Reconstruction tabs to read about the issues and how they were fixed.

Original


Source: Our World in Data (2020)


Objective

The objective of this original data visualisation is to show the number of confirmed case per day in Australia. What we can see that the curve goes up very quickly in a certain peiord and drop down fast after a few weeks later.

The targetted audience for this chat is anyone who is concerned about the trend and for those leaders who make some policies to control this disaster.

The visualisation chosen had the following three main issues:

  • Overall, this chart only told the audience how many cases were confirmed daily.
  • We cannot get extral information why the daily cofirmed cases were dropped.
  • It didn’t provide the ratio related to population.

Therefore, the reconstructed graph aims to answer why the curve dropped quickly and what’s the Australian contribution during these days.

During these weeks, there are many strict policies on social activities which can be reflected from Google Service usage, so I found the Google Mobility Report in Google, and it provides insights into what has changed in response to policies aimed at combating COVID-19.

In the reconstructed chart, I linked the Google Mobility Activities with the new cases confirm per million to address how people’s social activties have impact on the viuse transmition.

Reference

Code

The following code was used to fix the issues identified in the original.

library(readr)
library(ggplot2)
library(kableExtra)
library(dplyr)
library(knitr)
library(cowplot)

# load global mobility report
Global_Mobility_Report <- read_csv("Global_Mobility_Report.csv")

# extract australia mobility
Australia_Mobility_Report <- Global_Mobility_Report %>% filter(country_region_code == "AU")
Australia_Mobility_Report <- Australia_Mobility_Report[1:63,]

# filter columns
Australia_Mobility_Report <- Australia_Mobility_Report %>% select(country_region_code, date, retail_and_recreation_percent_change_from_baseline, grocery_and_pharmacy_percent_change_from_baseline, parks_percent_change_from_baseline, transit_stations_percent_change_from_baseline, workplaces_percent_change_from_baseline, residential_percent_change_from_baseline)

# rename columns
colnames(Australia_Mobility_Report) <- c("country_code", "date", "retail_recreation","grocery_pharmacy", "parks", "transit_stations", "workplaces", "residential")

# create social mobility
Australia_Mobility_Report <- Australia_Mobility_Report %>% mutate(social = (retail_recreation + grocery_pharmacy + parks + transit_stations + workplaces) / 5)

# load global covid19
Global_Covid19 <- read_csv("owid-covid-data.csv")

# extract australia data and select a range of data.
Australia_Covid19 <- Global_Covid19 %>% filter(iso_code == "AUS") %>% select(iso_code, date, new_cases_per_million) %>% filter(date >= min(Australia_Mobility_Report$date) & date <= max(Australia_Mobility_Report$date))

# join mobility and covid19 togeter
Australia_Case_Mobility <- inner_join(Australia_Covid19, Australia_Mobility_Report, by="date")

# select some columns
Australia_Case_Mobility <- Australia_Case_Mobility %>% select(date, new_cases_per_million, social, residential)

# create plot based on social mobility, residential mobility and new cases per million.
p1 <- ggplot(Australia_Case_Mobility, aes(x = date)) + 
  geom_line(aes(y=residential, colour = "residential mobility")) + 
  geom_line(aes(y=social, colour="social mobility")) + 
  geom_line(aes(y=new_cases_per_million, colour="new cases per million")) +
  labs(title="Mobility activity and cases", y = "mobility/cases") +
  theme_bw() +
  theme(plot.title = element_text(hjust = 0.5, face = "bold", size = 12))

# bar chart for new cases per million
p2 <- ggplot(Australia_Covid19, aes(date, new_cases_per_million,fill=new_cases_per_million)) +
      geom_bar(stat="identity", width=.90) + coord_flip() + 
      xlab("Date") + 
      ylab(" ") + 
      ggtitle("New cases per million") + 
      theme_bw() +
      theme(plot.title = element_text(hjust = 0.5, face = "bold", size = 10),
           axis.title.x = element_text(size = 10),
           axis.text.x = element_text(size = 8.5)) +
      scale_fill_continuous(low="#FA4040", high="#980303") + 
      theme(legend.position = "none")

# bar chart for social mobility
p3 <- ggplot(Australia_Case_Mobility, aes(date,social,fill=social)) +
      geom_bar(stat="identity", width=.90) + coord_flip() + 
      xlab("Date") + 
      ylab(" ") + 
      ggtitle("Social mobility") + 
      theme_bw() +
      theme(plot.title = element_text(hjust = 0.5, face = "bold", size = 10),
            axis.title.x = element_text(size = 10),
            axis.text.x = element_text(size = 8.5),
            axis.title.y = element_text(size = 10),
            axis.text.y = element_text(size = 8.5)) +
      scale_fill_continuous(low="#F0E028", high="#B8AA06") + 
      theme(legend.position = "none")

# bar chart for residential mobility
p4 <- ggplot(Australia_Case_Mobility, aes(date,residential,fill=residential)) +
      geom_bar(stat="identity", width=.90) + coord_flip() + 
      xlab("Date") + 
      ylab(" ") + 
      ggtitle("Residential mobility") + 
      theme_bw() +
      theme(plot.title = element_text(hjust = 0.5, face = "bold", size = 10),
            axis.title.x = element_text(size = 10),
            axis.text.x = element_text(size = 8.5),
            axis.title.y = element_text(size = 10),
            axis.text.y = element_text(size = 8.5)) +
      scale_fill_continuous(low="#378CF2", high="#003C85") + 
      theme(legend.position = "none")

# create plot row
row <- plot_grid(p2,p3,p4,ncol = 3, nrow = 1)

# add all chats into one plot
plot <- plot_grid(p1, row, nrow = 2)

Data Reference

Reconstruction

The following plot fixes the main issues in the original.