Whither goest thou, America, in thy shiny car in the night?
– Jack Kerouac

Building and embedding Shiny apps for more interactive fun
webscraping
shiny
maps
dictionary
Published

August 6, 2023

Shiny apps!


Shiny map app

Here is a Shiny app showing Covid deaths by country over time. It is hosted on my Shiny account and embedded here using iframe.

Shiny app map code

Here is the code behind the Shiny app:

Check out my code
# Replication of Covid-19 Shiny app from R4DEV
#
#

# Packages ####
library(bslib)
library(ggthemes)
library(leaflet)
library(leaflet.providers)
library(plotly)
library(raster)
library(RColorBrewer)
library(rgeos)
library(rnaturalearth)
library(rworldmap)
library(shiny)
library(shinydashboard)
library(shinythemes)
library(sp)
library(tidyverse)
library(lubridate)



# Data ####
covid_df <- readr::read_csv("https://raw.githubusercontent.com/owid/covid-19-data/master/public/data/owid-covid-data.csv") %>%
  dplyr::mutate(date = lubridate::as_date(date),
                n = row_number(),
                year = year(date)) %>%
  dplyr::select(iso_code, continent,country=location,date,deaths=total_deaths_per_million,pop=population)

# let's download the worldmap as a sp file ####
world_sp <- rworldmap::getMap(resolution = "low")



# The UI ####

ui_covid <- navbarPage( # 
  # Here we add the Quartz Bootwwatch theme
  theme = bslib::bs_theme(bootswatch = "morph"),
  title= "COVID-19: Aftermath",
  sidebarLayout(
    sidebarPanel(
      # Some intro text
      a("Shiny App to show the evolution of Covid-related deaths around the world between March 2020 and June 2023, using OWID data"),
      br(),
      br(),
      # A button that will trigger the update of the map/graph
      actionButton("update","Update data", icon = icon("refresh")),
      br(),
      br(),
      # Adding the period input
      dateRangeInput("date",
                     "Select period:",
                     start=min(covid_df$date),
                     end=max(covid_df$date)),
      br(),
      # Adding the countries input
      selectInput("country",
                  "Select country:",
                  choices = sort(unique(covid_df$country)),
                  selected= c("France","Italy","Colombia","India","Brazil"),
                  multiple = TRUE)
    ),
    # Now we layout the objects to render
    mainPanel(
      tabsetPanel(type = "tabs",
                  tabPanel("Map",leafletOutput("map")),
                  tabPanel("Trajectories", plotlyOutput("countries"))
      )))
)


# Server ####
server_covid <- function(input,output) {
  
  # This is where the button will filter the data by date and countries ####
  data <- eventReactive(input$update, #eventReactive depends on a single input, in this case, the name of the button we created called "update"
                        {
                          # We start with the full data
                          covid_df %>%
                            # We use the inputs in the UI to define dates (beginning and end) and countries, which is the %in% operator so it can be an expansive list
                            dplyr::filter(between(date,input$date[1],input$date[2]),
                                          !is.na(deaths),
                                          country %in% input$country) %>%
                            dplyr::group_by(iso_code,country,date) %>%
                            dplyr::summarise(total_deaths = sum(deaths)) %>%
                            dplyr::filter(!is.na(total_deaths))
                        }
  )
  # We build a reactive function that updates the data for the map ####
  data_map <- reactive({
    
    # We create a copy of the map
    world_sp2 <- world_sp
    
    # Then we merge the filtered data into the data object within the S4 map
    world_sp2@data <- world_sp2@data %>%
      dplyr::inner_join(covid_df %>%
                          # Same filtering principles as above
                          dplyr::filter(between(date,input$date[1],input$date[2]),
                                        !is.na(deaths),
                                        country %in% input$country) %>%
                          dplyr::group_by(iso_code,country,date) %>%
                          dplyr::summarise(total_deaths = sum(deaths)) %>%
                          dplyr::filter(!is.na(total_deaths)), 
                        by=c("ISO3"="iso_code"))
    
  })
  
  # Out first output: Leaflet map. We need to create an empty map and only update the map when the data changes, to make it more computationally efficient. So the first step only builds an empty map
  output$map <- renderLeaflet({
    
    leaflet() |>
      addTiles() |>
      addProviderTiles("Esri.WorldImagery") |>
      setView(20,-30,2)
  })
  
  # Then, once the button is clicked, the filtered data will go into the leafletproxy and the markers for the countries selected will appear
  observeEvent(input$update,
               {
                 leafletProxy("map") |>
                   clearMarkers() |>
                   addMarkers(data = data_map(), # Notice that the reactive functions are called with parenthesis at the end, as they are functions!
                              # We add a custom icon
                              icon = makeIcon(
                                iconUrl = "https://www.un.org/sites/un2.un.org/files/2020/04/covid-19.svg",
                                iconWidth = 20, iconHeight = 20
                              ),
                              label= ~paste0(country,": ",as.integer(total_deaths)))
               })
  
  
  # Our second object is a plotly, which is pretty straightforward
  output$countries <- renderPlotly({
    
    # Just notice that the reactive function for the data is included as data() !
    p <- data() %>% 
      ggplot(aes(x=date, y=total_deaths, color=country))+
      geom_path()+
      labs(x=NULL,y="Registered deaths",
           title="Progression in selected countries",
           caption = "Source: OWID")+
      scale_fill_distiller(direction=1)+
      theme(panel.background = element_rect(fill="rosybrown1"),
            legend.position='none')
    
    ggplotly(p)
    
  })
  
}

# Run the application 
shinyApp(ui = ui_covid, server = server_covid)

Coming soon…

This is a placeholder for a future Shiny app based on the Eunoia database we scraped in the last post.