Я пытаюсь создать интерактивное блестящее приложение, которое показывает пользователю карту Plotly и позволяет пользователю выбирать различные округа в США. Затем оно может использовать информацию о выбранных округах для создания диаграммы движения GoogleVis. Я успешно сконструировал программу локально, и вот пользовательский интерфейс и функция сервера:
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
})
}
Когда я запускал этот код локально, он работает так, как я хотел. Однако, когда я загружаю его на shiny.io, он не отображает диаграмму движения googleVis при выборе. Вот ссылка на мой shiny.io и журнал приложения: 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
Почему это могло произойти? Спасибо за вашу помощь!