Я пытаюсь создать интерактивную карту с помощью Plotly в приложении Shiny, которое позволяет пользователю выбирать регион с помощью поля выбора и лассо, выбирая на карте, затем он может вернуть диаграмму движения GoogleVis, показывающую статистику по выбранному региону в приложении Shiny. Однако, когда дело доходит до функции вывода в GoogleVis:
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))
})
Это дает ошибку:
Warning: Error in $: $ operator is invalid for atomic vectors
96: renderText [/Users/b.w.h/Documents/JHU/Summer 1/COVID-19 Modeling Project/County Polygon Visualization with Shiny/USMapWithCountyPolygon/server.R#114]
95: func
82: origRenderFunc
81: output$brush
1: runApp
Это очень странно, потому что, когда я проверял в консоли, фрейм данных что я пытаюсь подмножество с "$" не является atomi c.
is.atomic(totalComfirmed)
[1] FALSE
Почему это могло произойти? Вот мой полный интерфейс и функции сервера:
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)
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[,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)
colnames(covidDeath)[6] <- "countyNames"
totalDeath <- covidDeath[,ncol(covidDeath)]
v <- reactiveValues(data = totalComfirmed)
observeEvent(input$countyFill, {
if (input$countyFill == "Map by total confirmed") {
v$data <- totalComfirmed;
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")
# selectedCountyCases <- as.integer(unlist(selected[3]))
# brush <- selectedCounties
#})
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, server)
Спасибо за вашу помощь!