带有 Leaflet 和 Shiny 的交互式等值线图

Question

我正在尝试修改此repo 以显示等值线地图并使用滑块输入来更新地图。一切都好，直到我尝试为滑块输入设置动画，没有任何反应。我收到此控制台错误：input_binding_slider.js:199 Uncaught TypeError: Cannot read property 'options' of undefined。

这是我正在使用的代码：

library(dplyr) ; library(rgdal) ; library(leaflet)

gdp = read.csv("mexico2.csv", header= T) %>%
  as.data.frame()

mexico <- readOGR("mexico.shp", layer = "mexico", encoding = "UTF-8")

ui <- shinyUI(fluidPage(
  fluidRow(
    column(7, offset = 1,
           br(),
           div(h4(textOutput("title"), align = "center"), style = "color:black"),
           div(h5(textOutput("period"), align = "center"), style = "color:black"),
           br())),
  fluidRow(
    column(7, offset = 1,
           leafletOutput("map", height="530"),
           br(),
           actionButton("reset_button", "Reset view")),
    column(3,
           uiOutput("category", align = "left")))
))

server <- (function(input, output, session) {

  output$category <- renderUI({
    sliderInput("category", "Year:",
                 min=1994, max = 1999,
                 value = 1994, sep = "", animate=TRUE)
  })  

  selected <- reactive({
    subset(gdp,
           category==input$category)
  })

  output$title <- renderText({
    req(input$category)
    paste0(input$category, " GDP by State")
  })

  output$period <- renderText({
    req(input$category)
    paste("...")
  })

  lat <- 23
  lng <- -102
  zoom <- 5

  output$map <- renderLeaflet({

    leaflet() %>% 
      addProviderTiles("CartoDB.Positron") %>% 
      setView(lat = lat, lng = lng, zoom = zoom)
  })

  observe({
    mexico@data <- left_join(mexico@data, selected())

    qpal <- colorQuantile("YlGn", mexico$value, n = 5, na.color = "#bdbdbd")

    popup <- paste0("<strong>ID: </strong>",
                    mexico$id,
                    "<br><strong>Estado: </strong>",
                    mexico$name,
                    "<br><strong>Valor: </strong>",
                    mexico$value)

    leafletProxy("map", data = mexico) %>%
      addProviderTiles("CartoDB.Positron") %>% 
      clearShapes() %>% 
      clearControls() %>% 
      addPolygons(data = mexico, fillColor = ~qpal(value), fillOpacity = 0.7, 
                  color = "white", weight = 2, popup = popup) %>%
      addLegend(pal = qpal, values = ~value, opacity = 0.7,
                position = 'bottomright', 
                title = paste0(input$category, "<br>"))
  })

  observe({
    input$reset_button
    leafletProxy("map") %>% setView(lat = lat, lng = lng, zoom = zoom)
  })      

})

shinyApp(ui, server)

这是shinyapp的链接

我们将不胜感激。 谢谢！

Answer 1

这只是一个命名错误。您将htmlOutput 和命名为sliderOutput 用于“类别”。在内部，这把事情搞砸了。

只需更改，例如输出到

uiOutput("categoryOutput", align = "left")

和

output$categoryOutput <- renderUI({ ... })

你应该很高兴。

编辑：完整代码

library(dplyr) ; library(rgdal) ; library(leaflet)

gdp = read.csv("mexico2.csv", header= T) %>%
  as.data.frame()

mexico <- readOGR("mexico.shp", layer = "mexico", encoding = "UTF-8")

ui <- shinyUI(fluidPage(
  fluidRow(
    column(7, offset = 1,
           br(),
           div(h4(textOutput("title"), align = "center"), style = "color:black"),
           div(h5(textOutput("period"), align = "center"), style = "color:black"),
           br())),
  fluidRow(
    column(7, offset = 1,
           leafletOutput("map", height="530"),
           br(),
           actionButton("reset_button", "Reset view")),
    column(3,
           uiOutput("categoryOut", align = "left")))
))

server <- (function(input, output, session) {

  output$categoryOut <- renderUI({
    sliderInput("category", "Year:",
                 min=1994, max = 1999,
                 value = 1994, sep = "", animate=TRUE)
  })  

  selected <- reactive({
    subset(gdp,
           category==input$category)
  })

  output$title <- renderText({
    req(input$category)
    paste0(input$category, " GDP by State")
  })

  output$period <- renderText({
    req(input$category)
    paste("...")
  })

  lat <- 23
  lng <- -102
  zoom <- 5

  output$map <- renderLeaflet({

    leaflet() %>% 
      addProviderTiles("CartoDB.Positron") %>% 
      setView(lat = lat, lng = lng, zoom = zoom)
  })

  observe({
    mexico@data <- left_join(mexico@data, selected())

    qpal <- colorQuantile("YlGn", mexico$value, n = 5, na.color = "#bdbdbd")

    popup <- paste0("<strong>ID: </strong>",
                    mexico$id,
                    "<br><strong>Estado: </strong>",
                    mexico$name,
                    "<br><strong>Valor: </strong>",
                    mexico$value)

    leafletProxy("map", data = mexico) %>%
      addProviderTiles("CartoDB.Positron") %>% 
      clearShapes() %>% 
      clearControls() %>% 
      addPolygons(data = mexico, fillColor = ~qpal(value), fillOpacity = 0.7, 
                  color = "white", weight = 2, popup = popup) %>%
      addLegend(pal = qpal, values = ~value, opacity = 0.7,
                position = 'bottomright', 
                title = paste0(input$category, "<br>"))
  })

  observe({
    input$reset_button
    leafletProxy("map") %>% setView(lat = lat, lng = lng, zoom = zoom)
  })      

})

shinyApp(ui, server)