Я пытаюсь создать интерактивное блестящее приложение, которое показывает пользователю карту Plotly и позволяет пользователю выбирать различные округа в США. Затем оно может использовать информацию о выбранных округах для создания графиков и графиков. Однако кажется, что карта хороплет возвращает только значение curveNumber, pointNumber и z при выборе. Как я могу определить выбранный округ по этой информации? Или как я могу сделать так, чтобы он давал названия округов при выборе? Вот мой пользовательский интерфейс и функция сервера:
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("motionChart"),
verbatimTextOutput("brush")),
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)[6] <- "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$countyNames, covidCases[11,ncol(covidCases)])
gvisCasesData <- melt(data = setDT(covidCases), id.vars = "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",covidCases$FIPS)
colnames(covidDeath)[6] <- "countyNames"
totalDeath <- covidDeath[,c(which(names(covidDeath)=="countyNames"), ncol(covidDeath))]
names(totalDeath) <- c("countyNames", "totalDeath")
v <- reactiveValues(data = totalComfirmed)
observeEvent(input$countyFill, {
if (input$countyFill == "Map by total confirmed") {
v$data <- totalComfirmed$cases;
v$zmin = 100;
v$zmax = 12000;
v$hover <- with(covidCases, paste(countyNames));
}
if (input$countyFill == "Map by total death") {
v$data <- totalDeath;
v$zmin = 0;
v$zmax = 1600;
v$hover <- with(covidDeath, paste(countyNames));
}
})
observeEvent(input$submit, {
req(input$submit)
output$countyPolygonMap <- renderPlotly({
countyPolygonMap <- plot_ly(source = "countyMap") %>% add_trace(
countyName <- covidCases$countyNames,
type="choroplethmapbox",
geojson=countyGeo,
locations=fips,
z=v$data,
colorscale="Viridis",
zmin= v$zmin,
zmax= v$zmax,
text = ~v$hover,
marker=list(line=list(width=0),opacity=0.5)
) %>% 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$motionChart <- renderGvis({
# selected <- event_data(event = "plotly_selected", source = "countyMap")
# selectedCountyCases <- as.integer(unlist(selected[3]))
# selectedCounties <- subset(totalComfirmed, totalComfirmed$cases %in% selectedCountyCases)
# gvisCasesDataSubset <- subset(gvisCasesData, countyNames %in% c(selectedCounties$countyNames))
# motionChart <- gvisMotionChart(gvisCasesDataSubset, "countyNames", "Date", options=list(width=800, height=400))
#})
output$brush <- renderText({
selected <- event_data(event = "plotly_selected", source = "countyMap")
brush <- selected
})
output$statePolygonMap <-renderLeaflet ({
statesAbbr <- subset(statePolygonData, input$statesInput %in% statePolygonData$STUSPS);
## 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
})
}
shinyApp(ui = ui, server = server)
Большое спасибо за вашу помощь!