选择输入且弹出窗口不起作用时,闪亮的应用程序已与服务器断开连接

时间:2019-12-14 00:02:08

标签: r shiny leaflet shinyapps r-leaflet

我创建了这个闪亮的应用程序:

https://garrettrsmith.shinyapps.io/RIB_shinyapp/

在本地运行时,可以在SelectInput下拉菜单中切换年份。当我将应用程序部署到我的Shinyapps.io帐户上并在SelectInput下拉菜单中切换年份时,地图将变为灰色,并且显示“与服务器断开连接。重新加载”图标。我似乎也无法使弹出窗口正常工作。

Error

这是我的代码:

    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'的导出对象

感谢您提供的任何帮助。

0 个答案:

没有答案