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