我创建了这个闪亮的应用程序:
https://garrettrsmith.shinyapps.io/RIB_shinyapp/
在本地运行时,可以在SelectInput下拉菜单中切换年份。当我将应用程序部署到我的Shinyapps.io帐户上并在SelectInput下拉菜单中切换年份时,地图将变为灰色,并且显示“与服务器断开连接。重新加载”图标。我似乎也无法使弹出窗口正常工作。
这是我的代码:
site <- c("Browns Canyon", "Hancock", "Monarch Crest")
lat <- c("38.76210", "38.70581", "38.49185")
long <- c("-105.9776", "-106.3405", "-106.3171")
agency <- c("BLM", "USFS", "BLM")
Total2016 <- ("353", "1112", "9875")
Total2017 <- c("0", "138", "7435")
Total2018 <- c("201", "145", "16448")
Total2019 <- c("153", "0", "9655")
alluse <- data.frame(site, lat, long, Total2016, Total2017,
Total2018, Total2019)
ui <- navbarPage(
"Chaffee County Trail Counts", id = "nav",
tabPanel("Trail Count Map By Year", div(class = "outer",
tags$head(
includeCSS("www/style.css"),
includeScript("www/gomap.js")),
leafletOutput("UsageMap", width = "100%", height = "100%"),
absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE,
draggable = TRUE, top = 70, left = "auto", right = 20, bottom = "auto",
width = 330, height = "auto",
h2("Trailhead Explorer"),
selectInput("year", label = h4("Year:"),
choices = c("2016" = "Total2016",
"2017" = "Total2017",
"2018" = "Total2018",
"2019" = "Total2019"),
selected = "", width = "90%", multiple = FALSE),
tags$div(id="cite",
'Data provided by USFS and BLM and compiled for
Chaffee County Recreation in Balance')
))),
tabPanel("Trail Count Database",
DT::dataTableOutput("trailheadtable")
))
server <- function(input, output, session){
output$UsageMap <- renderLeaflet({
leaflet() %>%
addProviderTiles("Esri.WorldTopoMap") %>%
setView(lng = -106.183908, lat = 38.766663, zoom = 9)
})
observe({
yearcolorBy <- input$year
colorData <- alluse[[yearcolorBy]]
radius <- sqrt(alluse[[yearcolorBy]]) * 30
pal <- colorBin("viridis", colorData, 10, pretty = FALSE)
leafletProxy("UsageMap", data = alluse) %>%
clearShapes() %>%
addCircles(~long, ~lat, radius = radius, layerId =~ site,
stroke = FALSE, fillOpacity = 0.4, fillColor = pal(colorData)) %>%
addLegend("bottomleft", pal = pal, values = colorData, title = yearcolorBy, layerId = "colorLegend")
})
showTrailheadPopup <- function(site, lat, long) {
selectedSite <- alluse[alluse$site == site,]
content <- as.character(tagList(
tags$h4("Trailhead:", as.character(selectedSite$site)),
tags$h3("Agency:", as.character(selectedSite$agency)),
tags$br(),
sprintf("Total 2016: %s", as.numeric(selectedSite$Total2016)), tags$br(),
sprintf("Total 2017: %s", as.numeric(selectedSite$Total2017)), tags$br(),
sprintf("Total 2018: %s", as.numeric(selectedSite$Total2018)), tags$br(),
sprintf("Total 2019: %s", as.numeric(selectedSite$Total2019))
))
leafletProxy("UsageMap") %>% addPopups(lat, long, content, layerId = site)
}
observe({
leafletProxy("UsageMap") %>% clearPopups()
event <- input$map_shape_click
if (is.null(event))
return()
isolate({
showTrailheadPopup(event$id, event$lat, event$long)
})
})
output$trailheadtable <- DT::renderDataTable({
alluse %>%
filter(is.null(input$site)) %>%
mutate(Action = paste('<a class="go-map" href="" data-lat="', lat,
'" data-long="', long, '" data-trailhead="', site, '"><i class="fa fa-crosshairs"></i></a>',
sep=""))
action <- DT::dataTableAjax(session, alluse, outputId = "trailheadtable")
DT::datatable(alluse, options = list(ajax = list(url = action)), escape = FALSE)
})
}
我也遇到弹出窗口无法正常工作的问题。
我在下面的闪亮日志中包括我的警告:
2019-12-14T12:57:55.646156 + 00:00 Shinyapps [1598221]:警告:'is_weakref'中的错误不是'namespace:rlang'中的导出对象
2019-12-14T12:57:55.651640 + 00:00 Shinyapps [1598221]:[无可用堆栈跟踪]
2019-12-14T12:57:55.651907 + 00:00 Shinyapps [1598221]:错误:'is_weakref'不是'namespace:rlang'的导出对象
感谢您提供的任何帮助。