I am trying to create an interactive shiny app that shows the user a Plotly map and allows the user to select different counties in the U.S. Then it can use the info on the selected counties to generate a GoogleVis motion chart. I have successfully constructed the program locally, and here is the ui and server function:
library(shiny)
library(shinyWidgets)
library(plotly)
library(leaflet)
ui <- fluidPage(
titlePanel("Johns Hopkins COVID-19 Modeling Visualization Map"),
setBackgroundImage(
src = "https://brand.jhu.edu/assets/uploads/sites/5/2014/06/university.logo_.small_.horizontal.blue_.jpg"
),
sidebarLayout(
sidebarPanel(
radioButtons("countyFill", "Choose the County Map Type", c("Map by total confirmed", "Map by total death"), selected = "Map by total confirmed"),
checkboxGroupInput("statesInput", "Choose the State(s)",
c("AL", "MO", "AK", "MT", "AZ", "NE",
"AR", "NV", "CA", "NH", "CO", "NJ",
"CT", "NM", "DE", "NY", "DC", "NC",
"FL", "ND", "GA", "OH", "HI", "OK",
"ID", "OR", "IL", "PA", "IN", "RI",
"IA", "SC", "KS", "SD", "KY", "TN",
"LA", "TX", "ME", "UT", "MD", "VT",
"MA", "VA", "MI", "WA", "MN", "WV",
"MS", "WI", "WY"),
inline = TRUE),
actionButton("submit", "Submit (may take 30s to load)")
),
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("County Level", plotlyOutput("countyPolygonMap"),
htmlOutput("casesMotionChart"),
htmlOutput("deathMotionChart")),
tabPanel("State Level", leafletOutput("statePolygonMap")),
tags$div(
tags$p(
"JHU.edu Copyright © 2020 by Johns Hopkins University & Medicine. All rights reserved."
),
tags$p(
tags$a(href="https://it.johnshopkins.edu/policies/privacystatement",
"JHU Information Technology Privacy Statement for Websites and Mobile Applications")
)
)
)
)
)
)
library(shiny)
library(leaflet)
library(magrittr)
library(rgdal)
library(plotly)
library(rjson)
library(dplyr)
library(viridis)
library(googleVis)
library(lubridate)
library(reshape2)
library(data.table)
library(shinyWidgets)
server <- function(input, output, session) {
statepolygonZip <- download.file("https://www2.census.gov/geo/tiger/GENZ2018/shp/cb_2018_us_state_500k.zip",
destfile = "cb_2018_us_state_500k.zip");
unzip("cb_2018_us_state_500k.zip");
statePolygonData <- readOGR("cb_2018_us_state_500k.shp", layer = "cb_2018_us_state_500k",
GDAL1_integer64_policy = TRUE);
## obtaning the state shape file data provided by cencus.gov
## for more categories of region shape file:
## https://www.census.gov/geographies/mapping-files/time-series/geo/carto-boundary-file.html
url <- 'https://raw.githubusercontent.com/plotly/datasets/master/geojson-counties-fips.json'
countyGeo <- rjson::fromJSON(file=url)
## Obtaining the geographical file for all U.S. counties
url2<- "https://raw.githubusercontent.com/CSSEGISandData/COVID-19/master/csse_covid_19_data/csse_covid_19_time_series/time_series_covid19_confirmed_US.csv"
covidCases <- read.csv(url2, header = TRUE)
fips <- sprintf("%05d",covidCases$FIPS)
colnames(covidCases)[11] <- "countyNames"
totalComfirmed <- covidCases[,c(which(names(covidCases)=="countyNames"), ncol(covidCases))]
names(totalComfirmed) <- c("countyNames", "cases")
destroyX = function(es) {
f = es
for (col in c(1:ncol(f))){ #for each column in dataframe
if (startsWith(colnames(f)[col], "X") == TRUE) { #if starts with 'X' ..
colnames(f)[col] <- substr(colnames(f)[col], 2, 100) #get rid of it
}
}
assign(deparse(substitute(es)), f, inherits = TRUE) #assign corrected data to original name
}
destroyX(covidCases)
gvisCasesData <- cbind.data.frame(covidCases[,c(11:ncol(covidCases))])
gvisCasesData <- melt(data = setDT(gvisCasesData), id.vars = c("countyNames"),measure.vars = c(colnames(covidCases)[c(12:ncol(covidCases))]))
colnames(gvisCasesData)[2:3] <- c("Date", "numCases")
gvisCasesData$Date <- mdy(gvisCasesData$Date)
url3 <- "https://raw.githubusercontent.com/CSSEGISandData/COVID-19/master/csse_covid_19_data/csse_covid_19_time_series/time_series_covid19_deaths_US.csv"
covidDeath <- read.csv(url3, header = TRUE)
fips <- sprintf("%05d",covidDeath$FIPS)
colnames(covidDeath)[11] <- "countyNames"
totalDeath <- covidDeath[,c(which(names(covidDeath)=="countyNames"), ncol(covidDeath))]
names(totalDeath) <- c("countyNames", "totalDeath")
destroyX(covidDeath)
gvisDeathData <- cbind.data.frame(covidDeath[,c(11, 13:ncol(covidDeath))])
gvisDeathData <- melt(data = setDT(gvisDeathData), id.vars = c("countyNames"),measure.vars = c(colnames(covidDeath)[c(13:ncol(covidDeath))]))
colnames(gvisDeathData)[2:3] <- c("Date", "numDeath")
gvisDeathData$Date <- mdy(gvisDeathData$Date)
observeEvent(input$submit, {
req(input$submit)
observeEvent(input$countyFill, {
if (input$countyFill == "Map by total confirmed") {
output$countyPolygonMap <- renderPlotly({
countyPolygonMap <- plot_ly(source = "casesMap") %>% add_trace(
countyName <- covidCases$countyNames,
type="choroplethmapbox",
geojson=countyGeo,
locations=fips,
z=totalComfirmed$cases,
colorscale="Viridis",
zmin= 100,
zmax= 12000,
text = ~with(covidCases, paste(countyNames)),
marker=list(line=list(width=0),opacity=0.5),
customdata =~totalComfirmed$countyNames
) %>% layout(
mapbox=list(
style="carto-positron",
zoom =2,
center=list(lon= -95.71, lat=37.09))
%>% event_register(event = "plotly_selected")
);
countyPolygonMap;
## generating the interactive plotly map
})
output$casesMotionChart <- renderGvis({
selected <- event_data(event = "plotly_selected", source = "casesMap")$customdata
gvisCasesDataSubset <- subset(gvisCasesData, countyNames %in% c(selected))
motionChart <- gvisMotionChart(gvisCasesDataSubset, "countyNames", "Date", options=list(width="automatic", height="automatic"))
})
}
if (input$countyFill == "Map by total death") {
output$countyPolygonMap <- renderPlotly({
countyPolygonMap <- plot_ly(source = "deathMap") %>% add_trace(
countyName <- covidDeath$countyNames,
type="choroplethmapbox",
geojson=countyGeo,
locations=fips,
z=totalDeath$totalDeath,
colorscale="Viridis",
zmin= 0,
zmax= 1600,
text = ~with(covidDeath, paste(countyNames)),
marker=list(line=list(width=0),opacity=0.5),
customdata =~totalDeath$countyNames
) %>% layout(
mapbox=list(
style="carto-positron",
zoom =2,
center=list(lon= -95.71, lat=37.09))
%>% event_register(event = "plotly_selected")
);
countyPolygonMap;
## generating the interactive plotly map
})
output$deathMotionChart <- renderGvis({
selected <- event_data(event = "plotly_selected", source = "deathMap")$customdata
gvisDeathDataSubset <- subset(gvisDeathData, countyNames %in% c(selected))
motionChart <- gvisMotionChart(gvisDeathDataSubset, "countyNames", "Date", options=list(width="automatic", height="automatic"))
})
}
})
output$statePolygonMap <-renderLeaflet ({
statesAbbr <- subset(statePolygonData, statePolygonData$STUSPS %in% input$statesInput);
## subsetting the shape file with the selected states
leaflet(statesAbbr) %>%
addPolygons(color = "#444444", weight = 1, smoothFactor = 0.5,
opacity = 1.0, fillOpacity = 0.5,
fillColor = ~colorQuantile("YlOrRd", ALAND)(ALAND),
highlightOptions = highlightOptions
(color = "white", weight = 2,bringToFront = TRUE))
})
## producing the map with polygon boundary on the state level
})
}
It works as I wished when I ran these code locally. However, when I upload it to shiny.io, it does not display the googleVis motion chart upon selection. Here is the link to my shiny.io and the log of the app: https://voyagerwsh.shinyapps.io/USMapWithCountyPolygon/?_ga=2.224464666.160516643.1596758294-1394498961.1595634152
2020-08-06T23:31:34.235068+00:00 shinyapps[2621249]: the standard browser to display its output.
2020-08-06T23:31:34.235068+00:00 shinyapps[2621249]:
2020-08-06T23:31:34.235069+00:00 shinyapps[2621249]:
2020-08-06T23:31:34.235070+00:00 shinyapps[2621249]: To suppress this message use:
2020-08-06T23:31:34.235069+00:00 shinyapps[2621249]: or visit https://github.com/mages/googleVis.
2020-08-06T23:31:34.400619+00:00 shinyapps[2621249]:
2020-08-06T23:31:34.235070+00:00 shinyapps[2621249]: suppressPackageStartupMessages(library(googleVis))
2020-08-06T23:31:34.235070+00:00 shinyapps[2621249]:
2020-08-06T23:31:34.400621+00:00 shinyapps[2621249]: Attaching package: ‘lubridate’
2020-08-06T23:31:34.400622+00:00 shinyapps[2621249]:
2020-08-06T23:31:34.400985+00:00 shinyapps[2621249]: The following objects are masked from ‘package:base’:
2020-08-06T23:31:34.400986+00:00 shinyapps[2621249]:
2020-08-06T23:31:34.400986+00:00 shinyapps[2621249]: date, intersect, setdiff, union
2020-08-06T23:31:34.435502+00:00 shinyapps[2621249]:
2020-08-06T23:31:34.435504+00:00 shinyapps[2621249]: Attaching package: ‘data.table’
2020-08-06T23:31:34.435505+00:00 shinyapps[2621249]:
2020-08-06T23:31:34.400987+00:00 shinyapps[2621249]:
2020-08-06T23:31:34.435861+00:00 shinyapps[2621249]: The following objects are masked from ‘package:reshape2’:
2020-08-06T23:31:34.435862+00:00 shinyapps[2621249]:
2020-08-06T23:31:34.435862+00:00 shinyapps[2621249]: dcast, melt
2020-08-06T23:31:34.435863+00:00 shinyapps[2621249]:
2020-08-06T23:31:34.436223+00:00 shinyapps[2621249]: The following objects are masked from ‘package:lubridate’:
2020-08-06T23:31:34.436224+00:00 shinyapps[2621249]:
2020-08-06T23:31:34.436225+00:00 shinyapps[2621249]: yday, year
2020-08-06T23:31:34.436226+00:00 shinyapps[2621249]:
2020-08-06T23:31:34.436546+00:00 shinyapps[2621249]: The following objects are masked from ‘package:dplyr’:
2020-08-06T23:31:34.436546+00:00 shinyapps[2621249]:
2020-08-06T23:31:34.436547+00:00 shinyapps[2621249]: between, first, last
2020-08-06T23:31:34.436225+00:00 shinyapps[2621249]: hour, isoweek, mday, minute, month, quarter, second, wday, week,
2020-08-06T23:31:34.436547+00:00 shinyapps[2621249]:
2020-08-06T23:31:34.441844+00:00 shinyapps[2621249]: trying URL 'https://www2.census.gov/geo/tiger/GENZ2018/shp/cb_2018_us_state_500k.zip'
2020-08-06T23:31:34.666432+00:00 shinyapps[2621249]: downloaded 3.2 MB
2020-08-06T23:31:34.666434+00:00 shinyapps[2621249]:
2020-08-06T23:31:34.736005+00:00 shinyapps[2621249]: OGR data source with driver: ESRI Shapefile
2020-08-06T23:31:34.736007+00:00 shinyapps[2621249]: Source: "/srv/connect/apps/USMapWithCountyPolygon/cb_2018_us_state_500k.shp", layer: "cb_2018_us_state_500k"
2020-08-06T23:31:34.736028+00:00 shinyapps[2621249]: with 56 features
2020-08-06T23:31:34.736029+00:00 shinyapps[2621249]: It has 9 fields
2020-08-06T23:31:34.736030+00:00 shinyapps[2621249]: Integer64 fields read as doubles: ALAND AWATER
2020-08-06T23:31:38.640171+00:00 shinyapps[2621249]: Warning: `arrange_()` is deprecated as of dplyr 0.7.0.
2020-08-06T23:31:38.640173+00:00 shinyapps[2621249]: Please use `arrange()` instead.
2020-08-06T23:31:38.640174+00:00 shinyapps[2621249]: This warning is displayed once every 8 hours.
2020-08-06T23:31:38.640174+00:00 shinyapps[2621249]: See vignette('programming') for more help
2020-08-06T23:31:38.640175+00:00 shinyapps[2621249]: Call `lifecycle::last_warnings()` to see where this warning was generated.
2020-08-06T23:32:30.764605+00:00 shinyapps[2621249]: trying URL 'https://www2.census.gov/geo/tiger/GENZ2018/shp/cb_2018_us_state_500k.zip'
2020-08-06T23:32:30.913856+00:00 shinyapps[2621249]:
2020-08-06T23:32:30.972639+00:00 shinyapps[2621249]: Integer64 fields read as doubles: ALAND AWATER
2020-08-06T23:32:30.913854+00:00 shinyapps[2621249]: downloaded 3.2 MB
2020-08-06T23:32:30.972614+00:00 shinyapps[2621249]: It has 9 fields
2020-08-06T23:32:30.972586+00:00 shinyapps[2621249]: OGR data source with driver: ESRI Shapefile
2020-08-06T23:32:30.972599+00:00 shinyapps[2621249]: Source: "/srv/connect/apps/USMapWithCountyPolygon/cb_2018_us_state_500k.shp", layer: "cb_2018_us_state_500k"
2020-08-06T23:32:30.972605+00:00 shinyapps[2621249]: with 56 features
Why would this happen? Thanks for your kind help!
It may because the browser defaults on blocking the usage of flash. It can be enabled in Chrome like this: