Skip to content

Instantly share code, notes, and snippets.

@jokergoo

jokergoo/spiral_covid19_shiny.R

Last active November 13, 2023 10:57
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save jokergoo/fa39ee3dcf20cbc13a31bbe93c3498fb to your computer and use it in GitHub Desktop.
Save jokergoo/fa39ee3dcf20cbc13a31bbe93c3498fb to your computer and use it in GitHub Desktop.
Download ZIP
Raw
spiral_covid19_shiny.R
library(COVID19)
library(ComplexHeatmap)
library(circlize)
library(spiralize)
library(RColorBrewer)
library(shiny)
library(lubridate)
env = new.env()
load_data = function(progress = NULL) {
if(!is.null(progress)) {
progress$inc(1/4, detail = "download for all countries")
}
db1 = covid19()
if(!is.null(progress)) {
progress$inc(2/4, detail = "download for all states")
}
db2 = covid19(level = 2)
if(!is.null(progress)) {
progress$inc(3/4, detail = "process the tables")
}
## confirmed
suppressWarnings(all_countries_confirmed <- tapply(db1$confirmed, db1$administrative_area_level_1, max, na.rm = TRUE))
all_countries_confirmed = all_countries_confirmed[is.finite(all_countries_confirmed)]
states_confirmed = lapply(split(db2, db2$administrative_area_level_1), function(tb) {
suppressWarnings(x <- tapply(tb$confirmed, tb$administrative_area_level_2, max, na.rm = TRUE))
x[is.finite((x))]
})
## deaths
suppressWarnings(all_countries_deaths <- tapply(db1$deaths, db1$administrative_area_level_1, max, na.rm = TRUE))
all_countries_deaths = all_countries_deaths[is.finite(all_countries_deaths)]
states_deaths = lapply(split(db2, db2$administrative_area_level_1), function(tb) {
suppressWarnings(x <- tapply(tb$deaths, tb$administrative_area_level_2, max, na.rm = TRUE))
x[is.finite((x))]
})
## people_vaccinated
for(column in c("confirmed", "deaths", "people_vaccinated")) {
env[[column]] = list()
suppressWarnings(all_countries_vaccinated <- tapply(db1[[column]], db1$administrative_area_level_1, max, na.rm = TRUE))
env[[column]]$by_country = all_countries_vaccinated[is.finite(all_countries_vaccinated)]
env[[column]]$by_state = lapply(split(db2, db2$administrative_area_level_1), function(tb) {
suppressWarnings(x <- tapply(tb[[column]], tb$administrative_area_level_2, max, na.rm = TRUE))
x[is.finite((x))]
})
env[[column]]$total = sum(db1[[column]], na.rm = TRUE)
}
all_countries = names(all_countries_confirmed)
all_countries = c("All", all_countries)
if(!is.null(progress)) {
progress$inc(4/4, detail = "done")
}
env$db1 = db1
env$db2 = db2
env$all_countries = all_countries
env$date = as.character(max(db1$date))
}
load_data()
data_type_text = c("confirmed" = "confirmed", "deaths" = "deaths", "people_vaccinated" = "people vaccinated")
make_spiral_graph = function(country = "All", state = "All", data_type = "confirmed",
compare_to_year_mean = FALSE, graph_type = "barplot", smooth = FALSE) {
if(country == "All") {
date = env$db1$date
cases = env$db1[[data_type]]
cases = tapply(cases, date, sum, na.rm = TRUE)
cases[is.infinite(cases)] = NA
x = data.frame(date = names(cases), cases = cases)
colnames(x) = c("date", data_type)
x = x[order(x$date), , drop = FALSE]
} else if(state == "All") {
x = env$db1[env$db1$administrative_area_level_1 == country, , drop = FALSE]
} else {
x = env$db2[env$db2$administrative_area_level_1 == country & env$db2$administrative_area_level_2 == state, , drop = FALSE]
}
x$date = as.Date(x$date)
l = !is.na(x[[data_type]])
i = which(l)[1]
if(i > 1) {
x = x[-seq_len(i-1), , drop = FALSE]
}
for(i in which(is.na(x[[data_type]]))) {
x[[data_type]][[i]] = x[[data_type]][[i-1]]
}
x$daily_increased = diff(c(0, x[[data_type]]))
x$daily_increased[x$daily_increased < 0] = 0
l_extream = x$daily_increased > quantile(x$daily_increased[x$daily_increased > 0], 0.99)*2
if(any(l_extream)) {
ov = x$daily_increased[l_extream]
x$daily_increased[l_extream] = 0
}
if(country == "All") {
title = "Global"
title = paste0(title, ", ", as.character(min(x$date)), " ~ ", as.character(max(x$date)))
title = paste0(title, "\nTotal ", data_type_text[data_type], ": ", format(env[[data_type]]$total, big.mark = ","))
} else if(state == "All") {
title = country
title = paste0(title, ", ", as.character(min(x$date)), " ~ ", as.character(max(x$date)))
title = paste0(title, "\nTotal ", data_type_text[data_type], ": ", format(env[[data_type]]$by_country[country], big.mark = ","))
} else {
title = paste0(country, " / ", state)
title = paste0(title, ", ", as.character(min(x$date)), " ~ ", as.character(max(x$date)))
title = paste0(title, "\nTotal ", data_type_text[data_type], ": ", format(env[[data_type]]$by_state[[country]][state], big.mark = ","))
}
year_mean = tapply(x$daily_increased, year(x$date), mean)
x$year_mean = NA
for(y in names(year_mean)) {
x$year_mean[year(x$date) == as.numeric(y)] = year_mean[y]
}
if(smooth) {
smoothed_values = rep(0, nrow(x))
for(i in seq_len(nrow(x))) {
ind = seq(i - 3, i + 3)
ind = ind[ind > 0 & ind <= nrow(x)]
smoothed_values[i] = mean(x$daily_increased[ind])
}
x$daily_increased = smoothed_values
}
x$diff = (x$daily_increased - x$year_mean)/x$year_mean
x$diff[is.infinite(x$diff)] = 0
#############
spiral_initialize_by_time(xlim = range(x$date), verbose = FALSE, normalize_year = TRUE)
if(compare_to_year_mean) {
spiral_track(height = 0.8, background = FALSE, ylim = c(0, 1.05*max(abs(x$diff))))
} else {
spiral_track(height = 0.8, background = FALSE, ylim = c(0, 1.05*max(x$daily_increased)))
}
### background
bg_col = c("#F8F8F8", "#F0F0F0", "#E8E8E8", "#E0E0E0")
for(i in 1:4) {
spiral_rect(TRACK_META$xlim[1], TRACK_META$ylim[1] + TRACK_META$yrange*(i-1)/4,
TRACK_META$xlim[2], TRACK_META$ylim[1] + TRACK_META$yrange*i/4,
gp = gpar(fill = bg_col[i], col = NA))
}
if(compare_to_year_mean) {
l = x$diff > 0
if(graph_type == "barplot") {
spiral_bars(x$date[l], x$diff[l], gp = gpar(fill = 2, col = 2))
spiral_bars(x$date[!l], -x$diff[!l], gp = gpar(fill = 3, col = 3))
} else if(graph_type == "lollipop") {
spiral_lines(x$date[l], x$diff[l], type = "h", gp = gpar(col = 2))
spiral_points(x$date[l], x$diff[l], pch = 16, gp = gpar(col = 2))
spiral_lines(x$date[!l], -x$diff[!l], type = "h", gp = gpar(col = 3))
spiral_points(x$date[!l], -x$diff[!l], pch = 16, gp = gpar(col = 3))
}
} else {
col = c("confirmed" = 2, "deaths" = 4, "people_vaccinated" = 6)
if(graph_type == "barplot") {
spiral_bars(x$date, x$daily_increased, gp = gpar(fill = col[data_type], col = col[data_type]))
} else if(graph_type == "lollipop") {
spiral_lines(x$date, x$daily_increased, type = "h", gp = gpar(col = col[data_type]))
spiral_points(x$date, x$daily_increased, pch = 16, gp = gpar(col = col[data_type]))
}
if(any(l_extream)) {
ind_extream = which(l_extream)
note = "Extreame records removed from plot:"
for(i in seq_along(ind_extream)) {
ind = ind_extream[i]
spiral_points(x$date[ind], 0 - TRACK_META$yrange*0.06, pch = 16, size = unit(4, "mm"), gp = gpar(col = 2))
spiral_text(x$date[ind], 0 - TRACK_META$yrange*0.06, i, facing = "inside", nice_facing = TRUE, gp = gpar(fontsize = 8, col = "white"))
note = paste0(note, "\n", i, ". ", as.character(x$date[ind]), ": ", format(as.integer(ov[i]), big.mark = ","))
}
grid.text(note, x = unit(0.35, "npc"), y = unit(0.5, "npc"), gp = gpar(fontsize = 10), just = "left")
}
}
max = TRACK_META$ymax
at = grid.pretty(c(0, max))
at = at[at <= max]
labels = as.character(at)
labels[at >= 1000000] = paste0(at[at >= 1000000]/1000000, "M")
labels[at >= 1000 & at < 1000000] = paste0(at[at >= 1000 & at < 1000000]/1000, "K")
spiral_yaxis(at = at, labels = labels, labels_gp = gpar(fontsize = 10))
dd = max(x$date)
day(dd) = 15
dd = dd + months(1:12)
spiral_text(dd, y = 1.5, month.name[month(dd)], facing = "inside", nice_facing = TRUE)
if(2020 %in% year(x$date)) spiral_text("2020-01-01", TRACK_META$ycenter, "2020", gp = gpar(fontsize = 8))
if(2021 %in% year(x$date)) spiral_text("2021-01-01", TRACK_META$ycenter, "2021", gp = gpar(fontsize = 8))
if(2022 %in% year(x$date)) spiral_text("2022-01-01", TRACK_META$ycenter, "2022", gp = gpar(fontsize = 8))
grid.text(title, x = unit(0, "npc") + unit(5, "mm"), y = unit(1, "npc") - unit(5, "mm"), just = c("left", "top"),
gp = gpar(fontsize = 18))
if(compare_to_year_mean) {
lgd = Legend(labels = c("higher than year mean", "lower than year mean"), legend_gp = gpar(fill = 2:3, col = 2:3))
draw(lgd, x = unit(0.5, "npc"), y = unit(0.45, "npc"))
}
}
ui = fluidPage(
titlePanel('Spiral Graph of COVID-19 Daily Increase'),
sidebarLayout(
sidebarPanel(
selectInput('data_type', 'Date type', structure(names(data_type_text), names = data_type_text), selected = "confirmed"),
hr(),
selectInput('country', 'Country', structure(env$all_countries, names = env$all_countries), selected = "All"),
checkboxInput('country_order_by', "Order countries by total cases?", FALSE),
selectInput('state', 'State', c("All" = "All")),
checkboxInput('state_order_by', "Order states by total cases?", FALSE),
hr(),
radioButtons("graph_type", "Graph type:", c("Barplot" = "barplot", "Lollipop chart" = "lollipop"), selected = "barplot"),
checkboxInput("smooth", "Smooth by averaging neighbouring 7 days?", FALSE),
checkboxInput('compare_to_year_mean', "Compare to the average of current year? Values on y-axis are calculated as (x - yearly_mean)/yearly_mean.", FALSE),
hr(),
p(HTML("Graph made by <a href='https://CRAN.R-project.org/package=spiralize' target='_blank'>spiralize</a> package. Source code of the app is avaiable at <a href='https://gist.github.com/jokergoo/fa39ee3dcf20cbc13a31bbe93c3498fb' target='_black'>here</a>.")),
width = 3
),
mainPanel(
plotOutput('plot', height = "800px"),
width = 6
),
)
)
server = function(input, output, session) {
output$plot = renderPlot({
data_type = input$data_type
country = input$country
state = input$state
compare_to_year_mean = input$compare_to_year_mean
graph_type = input$graph_type
smooth = input$smooth
state_num = env[[data_type]]$by_state
if(state != "All") {
if(!state %in% names(state_num[[country]])) {
return(NULL)
}
}
make_spiral_graph(country, state, data_type = data_type,
compare_to_year_mean = compare_to_year_mean,
graph_type = graph_type, smooth = smooth)
})
observeEvent(input$data_type, {
data_type = input$data_type
country = input$country
state = input$state
country_num = env[[data_type]]$by_country
if(input$country_order_by) {
all_countries = names(sort(country_num, decreasing = TRUE))
} else {
all_countries = names(country_num)
}
all_countries = c("All", all_countries)
updateSelectInput(session, 'country', 'Country', structure(all_countries, names = all_countries), selected = input$country)
state_num = env[[data_type]]$by_state
if(!is.null(state_num[[country]])) {
s = state_num[[country]]
if(input$state_order_by) {
s = sort(s, decreasing = TRUE)
}
s = names(s)
s = c("All", s)
updateSelectInput(session, "state", "State", structure(s, names = s), selected = input$state)
}
})
observeEvent(input$country, {
data_type = input$data_type
country = input$country
state_num = env[[data_type]]$by_state
if(!is.null(state_num[[country]])) {
s = state_num[[country]]
if(input$state_order_by) {
s = sort(s, decreasing = TRUE)
}
s = names(s)
s = c("All", s)
updateSelectInput(session, "state", "State", structure(s, names = s), selected = "All")
} else {
updateSelectInput(session, "state", "State", c("All" = "All"), selected = "All")
}
})
observeEvent(input$country_order_by, {
data_type = input$data_type
country_num = env[[data_type]]$by_country
if(input$country_order_by) {
all_countries = names(sort(country_num, decreasing = TRUE))
} else {
all_countries = names(country_num)
}
all_countries = c("All", all_countries)
updateSelectInput(session, 'country', 'Country', structure(all_countries, names = all_countries), selected = input$country)
})
observeEvent(input$state_order_by, {
data_type = input$data_type
country = input$country
state_num = env[[data_type]]$by_state
if(!is.null(state_num[[country]])) {
s = state_num[[country]]
if(input$state_order_by) {
s = sort(s, decreasing = TRUE)
}
s = names(s)
s = c("All", s)
updateSelectInput(session, "state", "State", structure(s, names = s), selected = input$state)
}
})
}
shinyApp(ui = ui, server = server)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment