Corona Dashboard for European Countries in a Shiny App based on data from Johns Hopkins

Corona Dashboard for European Countries (Shiny App).R

#---------------------------------------------------------------------------------------------------------------
# Corona / COVID-19 Shiny App Dashboard for European Countries based on Data from Johns Hopkins
#
# Author: Jonas Schröder
#
# Medium: https://medium.com/@jonas.schroeder1991
# Github: https://github.com/JonasSchroeder 
# Twitter: https://twitter.com/J_Schroeder91 
# LinkedIn: https://www.linkedin.com/in/jonas-schröder-914a338a/ 
# 
# Happy to connect! :)
#
#---------------------------------------------------------------------------------------------------------------

library(shiny)
library(readr)
library(ggplot2)
library(dplyr)
library(lubridate)
library(httr)
library(stringr)

# DL time series data from GitHub
yesterday <- as.character(Sys.Date()-1)
date_list <- seq(as.Date("2020-02-13"), as.Date(yesterday), by="days") %>% format("%m-%d-%Y")

# Data frame where data tables per day are rbind to a big table
data <- data.frame()

# Collection of daily data tables (untransformed)
day_data <- list()

# Data Grabber Loop
for(i in 1:length(date_list)){
    # load data for certain day
    current_date <- date_list[i]
    data_temp <- read.csv(text=as.character(GET(str_glue("https://raw.github.com/CSSEGISandData/COVID-19/master/csse_covid_19_data/csse_covid_19_daily_reports/{current_date}.csv"))))
    
    # unify column names (as the structure and naming of Johns Hopkins' exports change over time)
    colnames_temp <- colnames(data_temp) %>% str_replace_all( "_", ".")
    colnames(data_temp) <- colnames_temp
    
    day_data[[i]] <- data_temp
    
    data_temp_transformed <- tribble(~Country, ~Date, ~Confirmed, ~Deaths,
                                     "Germany", current_date, filter(data_temp, data_temp$Country.Region=="Germany")$Confirmed, filter(data_temp, data_temp$Country.Region=="Germany")$Deaths,
                                     "Italy", current_date, filter(data_temp, data_temp$Country.Region=="Italy")$Confirmed, filter(data_temp, data_temp$Country.Region=="Italy")$Deaths,
                                     "Spain", current_date, filter(data_temp, data_temp$Country.Region=="Spain")$Confirmed, filter(data_temp, data_temp$Country.Region=="Spain")$Deaths,
                                     "United Kingdom", current_date, sum(filter(data_temp, data_temp$Country.Region=="United Kingdom")$Confirmed), sum(filter(data_temp, data_temp$Country.Region=="United Kingdom")$Deaths),
                                     "Netherlands", current_date, sum(filter(data_temp, data_temp$Country.Region=="Netherlands")$Confirmed), sum(filter(data_temp, data_temp$Country.Region=="Netherlands")$Deaths),
                                     "France", current_date, sum(filter(data_temp, data_temp$Country.Region=="France")$Confirmed), sum(filter(data_temp, data_temp$Country.Region=="France")$Deaths))
    
    # combine day data with existing data
    data <- rbind(data, data_temp_transformed)
}

# Transform column types
data$Date <- lubridate::mdy(data$Date)
data$Confirmed <- as.numeric(data$Confirmed)

# Group data by country and order by date
data <- data[order(data$Country, data$Date),]

# Calculate difference between days to estimate new cases per day
data$diff <-  c(0, diff(data$Confirmed))

# List of countries to look at (if you want to see different countries, be sure to change the Data Grabber Loop loop above)
country_list <- list(
    "Italy" = "Italy",
    "Germany" = "Germany",
    "Spain" = "Spain",
    "France" = "France",
    "Netherlands" = "Netherlands",
    "United Kingdom" = "United Kingdom"
)



# Define the UI for the Corona Dashboard---------------------------------------------------------------------------------------------------------------
ui <- fluidPage(
    
    # Shiny App Title
    titlePanel("Corona / COVID-19 Dashboard for European Countries"),
    
    # Rows
    fluidRow(
        
        # Row 1
        column(12,
               helpText("Select countries and date range using the options below this text box.",
                        str_glue("The dynamic graph regenerates based on your input. Data source: Johns Hopkins until {yesterday}."),
                            "https://github.com/CSSEGISandData/COVID-19",
                            align="center"
               )),
        
        # Row 2
        column(12,
               align="center",
               
               # select dstart date
               dateInput(inputId = "startDate",
                         label = "Select a Start Date",
                         value = as.character(Sys.Date()-14)
               ),
               
               # select countries to show data fro
               selectInput(inputId = "countries", 
                           label = "Select Countries to plot", 
                           country_list, 
                           selected = "Germany", 
                           multiple = TRUE)
               
        ),
        
        #Row 3
        column(6, verbatimTextOutput("startDate")),
        
        
        # Main panel for graph output / plot
        mainPanel(
            
            # Output: Plot curve for selected countries (daily difference and total)
            plotOutput(outputId = "plot1"),
            plotOutput(outputId = "plot2"),
            width = 12
            
        )
    )
)

# Define Server Logic for the Dashboard---------------------------------------------------------------------------------------------------------------
server <- function(input, output) {
    
    # Each time the user changes the settings, data_temp is updated based on these settings (filtered etc.)
    data_temp <- reactive({
        filter(data, data$Country %in% input$countries) %>% filter(Date >= input$startDate)
    })
    
    # Re-render plot based on user settings
    
    # Plot 1: Cases per Day
    output$plot1 <- renderPlot({
        
        ggplot(data_temp(), aes(x=Date, y=diff, color=Country)) +
            geom_line() +
            xlab("Date") +
            ylab("Cases per Day") +
            ggtitle("Confirmed Cases per Day") +
            theme(
                legend.position="right",
                axis.title = element_text(size=16),
                axis.text = element_text(size=16),
                plot.title = element_text(size=20),
                legend.title = element_text(size=16),
                legend.text = element_text(size=18)
            )
        
    })
    
    # Plot 2: Total Confirmed Cases
    output$plot2 <- renderPlot({
        
        ggplot(data_temp(), aes(x=Date, y=Confirmed, color=Country)) +
            geom_line() +
            xlab("Date") +
            ylab("Total Cases") +
            ggtitle("Total Confirmed Cases") +
            theme(
                legend.position="right",
                axis.title = element_text(size=16),
                axis.text = element_text(size=16),
                plot.title = element_text(size=20),
                legend.title = element_text(size=16),
                legend.text = element_text(size=18)
            )
        
    })
}

# Combine UI and Server settings to create and start the Shiny Ap p------------------------------------------------------------------------
shinyApp(ui = ui, server = server)