Global analysis

This analysis uses data provided by Facebook, under the Data For Good / GeoInsights initiative. This document contains all the code necessary to repeat this analysis. However, you will need to have access to the Facebook GeoInsights data. More information is available at: https://dataforgood.fb.com/docs/covid19/

To see further analysis for individual countries, visit https://people.eng.unimelb.edu.au/vkostakos/covid19/.

Below is an animation of how the covid-19 cases are related to the reduction in driving in various countries. The mobility index indicates the relative reduction in driving in each country. The covid-19 data is obtained from here, while the mobility data is provided by Apple.

continents <- vroom("../data/animation/continents.csv")


# https://www.apple.com/covid19/mobility
movement_data <- vroom("https://github.com/ActiveConclusion/COVID19_mobility/raw/master/apple_reports/applemobilitytrends.csv") %>%
  filter(geo_type != "city") %>% select(-geo_type) %>%
  gather(key = "date", value = "mobility", -region,-transportation_type) %>%
  rename(country=region) %>%
  mutate(date=ymd(date)) %>%
  mutate(mobility = as.numeric(mobility))

# http://raw.githubusercontent.com/owid/covid-19-data/master/public/data/owid-covid-data.csv
covid <- vroom("http://raw.githubusercontent.com/owid/covid-19-data/master/public/data/owid-covid-data.csv") %>% 
  select(-continent) %>%
  rename(country=location) %>%
  arrange(country,date) %>%
  group_by(country) %>%
  fill(total_cases_per_million, .direction = "downup") %>%
  right_join(continents,by="country") %>%
  rename(population = population.y)



combined <- movement_data %>% 
  full_join(covid, by=c("country","date")) %>%
  filter(!is.na(transportation_type)) %>%
  filter(date>("2020-02-25")) %>%
  group_by(country,transportation_type) %>%
  fill(total_cases_per_million, .direction = "downup") %>%
  fill(continent, .direction = "downup") %>%
  fill(population, .direction = "downup")



fig <-   combined %>% 
  filter(transportation_type=="driving") %>%
  mutate(date = as.character(date)) %>%
  arrange(country, transportation_type, date) %>%
  mutate(total_cases_per_million = total_cases_per_million+2) %>%
  plot_ly(
    x = ~total_cases_per_million,
    y = ~mobility,
    size = ~log(population),
    color = ~continent,
    frame = ~date,
    ids = ~country,
    text = ~country,
    hoverinfo = "text",
    type = 'scatter',
    mode = 'markers'
  )
fig <- fig %>% layout(
  xaxis = list(
    type = "log",
    title = "Covid-19 cases per million"
  ), 
  yaxis = list(
    title = "Mobility index (driving)"
  )
) %>% config(displayModeBar = FALSE)

fig

Below is a visualisation of the “compliance rate” of different countries over time. This shows the percentage of citizens who remained in their local region and did not move to another region on any given day. This is estimated using the Facebook GeoInsights data, and you can visit the pages for each individual country for more details.

compliance <- list.files(path = paste("../data/compliance/",sep=""), pattern = "*?\\.csv$", full.names = T) %>%
  lapply(function(x) read.csv(x)) %>%
  bind_rows()


base <- plot_ly(highlight_key(compliance,~country), #width =600, height = 400,
                text=~country,hoverinfo="text",color=~country) %>% 
  group_by(country) %>% add_lines(x=~date,y=~compliance)%>% 
  config(displayModeBar = FALSE)
base
raw_data <- data.frame(filename=list.files(path = "../data/", 
                                    pattern = "*?\\.csv$", full.names = F, recursive = T)) %>%
  mutate(filename=sub("__","_",filename)) %>%
  separate(filename,c("country","type","file"), sep="/") %>% 
  separate(file,c("ignore","date"),sep="_") %>%
  mutate(date=sub(".csv","",date)) %>%
  separate(date,c("date","hour"), sep=" ") %>% 
  select(-ignore) %>%
  filter(!is.na(date)) %>%
  filter(country!="melbourne") %>%
  mutate(date=ymd(date))
  

raw_data %>% 
  filter(type=="movement_interactive") %>%
  ggplot(aes(x=date, y=country)) + 
     geom_tile() +
     scale_y_discrete(limits = rev(levels(as.factor(raw_data$country)))) +
     theme_bw() +
    scale_x_date(date_labels = "%a\n%d/%m") +
    labs(title=paste("Facebook data availability"),
         subtitle= "Dataset: FB interactive movement map", 
         y="country", 
         x= "Date") +
      theme(plot.title = element_text(hjust = 0.5),  
          plot.subtitle = element_text(hjust = 0.5),   
          panel.grid.major.y = element_blank(),
          panel.grid.minor.y = element_blank(),
          panel.grid.major.x = element_blank(),
          panel.grid.minor.x = element_blank())

raw_data %>% 
  filter(type=="pop") %>%
  group_by(country,date) %>% 
  summarize(count=n()) %>%
  ggplot(aes(x=date, y=country)) + 
     geom_tile(aes(fill=count)) +
     scale_y_discrete(limits = rev(levels(as.factor(raw_data$country)))) +
     theme_bw() +
    scale_x_date(date_labels = "%a\n%d/%m") +
    labs(title=paste("Facebook data availability"),
         subtitle= "Dataset: FB population map", 
         y="country", 
         x= "Date") +
      theme(plot.title = element_text(hjust = 0.5),  
          plot.subtitle = element_text(hjust = 0.5),   
          panel.grid.major.y = element_blank(),
          panel.grid.minor.y = element_blank(),
          panel.grid.major.x = element_blank(),
          panel.grid.minor.x = element_blank(),
          legend.position = "none")

pixel