带有传单和闪亮的动态多边形值答案

【问题标题】：Dynamic polygons value with leaflet and shiny带有传单和闪亮的动态多边形值
【发布时间】：2017-07-16 18:02:04
【问题描述】：

我想生成彩色多边形，动态值基于从组合框中选择的选项（特定供应商名称）。

我使用传单包打印基于“SpatialPolygonsDataFrame”对象类的多边形。它工作正常。我在使用“反应式”闪亮功能时遇到问题 - 将对象类从“SpatialPolygonsDataFrame”更改为“data.frame” - 不可能创建 leflet 地图。

这是我的代码的一部分：

ui <- pageWithSidebar(
  sidebarPanel(
    # supplier selection
    selectInput(inputId = "inpSuppl", label = "supplier:",
      choices = sort(x=names(table(db$SUPPLIER)), decreasing=FALSE),
      selected = sort(x=names(table(db$SUPPLIER)), decreasing=FALSE)[[1]]
    )
  ),
  mainPanel(leafletOutput("myMap"))
)

server <- function(input, output, session) {
  myData <- reactive({
    data <- data[data$SUPPLIER==input$inpSuppl, c("A_COLUMN")]
  })

  output$myMap <- renderLeaflet({
    m <- leaflet()
    m <-  addTiles(m)
    m <-  addPolygons(map = m, data = myData(), stroke = FALSE, fillColor = ~pal(mapval))
  })
}

shinyApp(ui=ui, server=server)

有什么想法吗？

非常感谢。我还有另一个问题 - 调色板。我想更改集群的数量，然后为多边形着色。当我启动应用程序时，一切都很好，但是当我在输入字段中更改集群数量后，集群数量无法正常工作（集群数量不会缩小）。

ui <- bootstrapPage(
  leafletOutput("myMap", width = "100%", height = "100%"),
  absolutePanel(top = 100, left = 10, width = "160px",
    # input - supplier
    selectInput(inputId = "inpSuppl", label = "supplier:",
      choices = sort(x=names(table(db$SUPPLIER)), decreasing=FALSE),
      selected = sort(x=names(table(db$SUPPLIER)), decreasing=FALSE)[[1]]
    ),
    # input - variable type
    selectInput(inputId = "inpVar", label = "variable:", choices = c("turnover" = "VAL_1", "basket" = "VAL_2")),
    # numeric input - number of clusters        
    numericInput(inputId="inpClust", label="number of clusters:", value=3, step=1)
  )
)

# --------------------------------------------------------------------------

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

  # dynamic number of clusters
  clusters <- reactive({input$inpClust})

  # dynamic data set - adding specific variable from db object to sh2 object
  ld <- reactive({
    # add aditional data to sh2 object (SpatialPolygonsDataFrame class)
    # from db obejct (data.frame class)
    sh2$mapval <- db[db$SUPPLIER==input$inpSuppl, c(input$inpVar)]
    # create clusters
    k <- kmeans(sh2$mapval, clusters())
    # add clusters to sh2 object (SpatialPolygonsDataFrame class)
    sh2$cluster <- k$cluster
    return(sh2)
  })

  # create color pal
  colorpal <- reactive({colorNumeric(palette="YlOrRd", ld()$cluster)})

  # static map elements
  output$myMap <- renderLeaflet({
    m <- leaflet("myMap") # preapare leaflet object
    m <- addTiles(m)
    m <- addPolygons(m, data = sh0, color = "black", weight = 1, fillColor = "black") # country polygon
  })

  # dynamic map elements
  observe({
    pal <- colorpal()
    leafletProxy("myMap", data = ld()) %>%
      addPolygons(stroke = FALSE, fillColor = ~pal(cluster), fillOpacity=0.6, popup = ~paste(mapval)) # powiats polygons
  })

}

【问题讨论】：

您有数据示例吗？
我从这里下载了 'shp 文件：'codgik.gov.pl/index.php/darmowe-dane/prg.html' PRG – jednostki administracyjne。我想 1）根据选择的供应商过滤数据，2）动态添加数据到 'SpatialPolygonsDataFrame' 对象 3）在传单地图上打印结果。
我不认为你的链接粘贴在
您可以将形状文件直接传递给传单，而无需转换为“SpatialPolygonsDataFrame”。如果 shapefile 在您可以使用的选项的名称列表中，则可以使用 data[input$inpSuppl]，并且不会更改任何内容。
myData <- reactive({ data <- data[data$SUPPLIER==input$inpSuppl, c("A_COLUMN")] data }) 如果您告诉反应函数返回而不是仅仅分配，它应该可以解决您的问题。此外，您只返回一列。需要退货吗？

标签： r

【解决方案1】：

ui <- pageWithSidebar(
  sidebarPanel(
    # supplier selection
    selectInput(inputId = "inpSuppl", label = "supplier:",
      choices = sort(x=names(table(db$SUPPLIER)), decreasing=FALSE),
      selected = sort(x=names(table(db$SUPPLIER)), decreasing=FALSE)[[1]]
    )
  ),
  mainPanel(leafletOutput("myMap"))
)

server <- function(input, output, session) {
  myData <- reactive({
    data <- data[data$SUPPLIER==input$inpSuppl, c("A_COLUMN")]
    data
  })

  output$myMap <- renderLeaflet({
    m <- leaflet()
    m <-  addTiles(m)
    m <-  addPolygons(map = m, data = myData(), stroke = FALSE, fillColor = ~pal(mapval))
  })
}

shinyApp(ui=ui, server=server)

根据上面的 cmets。

【讨论】：