0

我正在使用 Shiny 的 varSelectInput 函数来显示带有来自 spatialpolygondataframe 的 R Leaflet 的地图，以便通过选择对象的变量来绘制相应变量的地图并更改其颜色。为此，我从条件 varSelectInput 生成了 R 传单的 ColorBin 函数的反应对象。所有这些都在渲染地图时正常工作，因此地图被绘制，更新了图例的颜色和标题。但是，在部署图例 (addLegend) 时，我没有预期的结果，因为它没有显示。我尝试在渲染地图时从反应对象传递参数，就像我使用 addPolygons 函数一样，但我没有达到预期的结果。如下图： 在此处输入图片描述

43/5000 我使用的代码如下：

library(shiny)
library(leaflet)
library(tidyverse)



ssd_map <- leaflet() %>% addProviderTiles("CartoDB.DarkMatter")%>% setView(-8.53, 42.90, zoom = 12) 

ui <- fluidPage(
  titlePanel("Santiago de Compostela"),

  mainPanel(
    varSelectInput(
      inputId = "option",
      label = "Elige la información a representar:",
      data = dataframe1  %>% select(`Población Total`,`Población Masculina`,`Población Femenina`,`Población < 16 años`)
    ),
    leafletOutput("map")
  ))

server <- function(input, output) {



  colorpal <- reactive({

    if(input$option == "Población Total") {
      colorBin("Blues",data$`Población Total`,bins = 5)
    } else if (input$option == "Población Masculina"){
      colorBin("Reds",data$`Población Masculina`,bins = 5)

    } else if (input$option == "Población Femenina"){
      colorBin("Oranges",data$`Población Femenina`,bins = 5)

    } else
      colorBin("Greens",data$`Población < 16 años`,bins = 5)

  })



  leyenda <- reactive({

    if(input$option == "Población Total") {
      data$`Población Total`



    } else if (input$option == "Población Masculina"){
      data$`Población Masculina`

    } else if (input$option == "Población Femenina"){
      data$`Población Femenina`

    } else

      data$`Población < 16 años`
  })






  output$map <- renderLeaflet({
    ssd_map

  })

  observe({

    pal <- colorpal()
    leg <- leyenda()

    leafletProxy("map", data = dat1) %>%
      clearShapes() %>%
      clearControls() %>%
      addPolygons(color = "#444444" ,
                  weight = 1, 
                  smoothFactor = 0.5,
                  opacity = 1.0,
                  fillOpacity = 0.5,
                  popup = ~paste(input$option) ,
                  fillColor = ~pal(eval(as.symbol(input$option))))%>%

      addLegend(position = "topright", pal = pal , values =leg[input$option] ,
                title =  ~paste(input$option)) 



  })
}

shinyApp(ui = ui, server = server)
4

1 回答 1

0

您好经过几次尝试，我已经达到了这个解决方案：

图书馆（闪亮） 图书馆（传单） 图书馆（leaflet.extras）

加载（“./Datos.Rdata”）

ui <-流体页面（titlePanel（“圣地亚哥德孔波斯特拉”），

mainPanel(

    selectInput("option", "Option:", 
    choices= c("Población Total","Población Masculina","Población Femenina","Población < 16 años")),
    leafletOutput("map")
))

服务器 <- 功能（输入，输出）{

colorpal <- reactive({

    if(input$option == "Población Total") {
        colorBin("Blues",dat1$`Población Total`,bins = 5)
    } else if (input$option == "Población Masculina"){
        colorBin("Reds",dat1$`Población Masculina`,bins = 5)

    } else if (input$option == "Población Femenina"){
        colorBin("Oranges",dat1$`Población Femenina`,bins = 5)

    } else
        colorBin("Greens",dat1$`Población < 16 años`,bins = 5)

})




ventana <- reactive({

    if(input$option == "Población Total") {
         paste0("<b>", "Población Total: ", "</b>", as.character(dat1$`Población Total`))
    } else if (input$option == "Población Masculina"){
        paste0("<b>", "Población Masculina: ", "</b>", as.character(dat1$`Población Masculina`))

    } else if (input$option == "Población Femenina"){
        paste0("<b>", "Población Femenina: ", "</b>", as.character(dat1$`Población Femenina`))

    } else
        paste0("<b>", "Población < 16 años: ", "</b>", as.character(dat1$`Población < 16 años`))

})



output$map <- renderLeaflet({


    leaflet() %>% setView(-8.53, 42.90, zoom = 10)%>%
        addBootstrapDependency() %>% 
        # Base groups

        addProviderTiles(providers$CartoDB.DarkMatter , group = "CartoDB.DarkMatter") %>%
        addProviderTiles(providers$Esri.WorldImagery , group = "Esri.WorldImagery") %>%
        addMiniMap(
            tiles = providers$Esri.WorldImagery,
            toggleDisplay = TRUE)

})


observe({

    pal <- colorpal()
    popup1 <-ventana()
    proxy <- leafletProxy("map", data = dat1)
    proxy %>% clearShapes() %>%clearControls()
    if (input$option == "Población Total") {
        proxy %>% addPolygons(color = "#444444" ,
                              weight = 1, 
                              smoothFactor = 0.5,
                              opacity = 1.0,
                              fillOpacity = 0.5,
                              popup = popup1 ,
                              fillColor = ~pal(dat1[[input$option]]))%>% 

            addLegend(position = "topright", pal = pal, values = dat1[[input$option]] ,
                      title =  ~paste(input$option)) }

    else  if (input$option  == "Población Masculina") {

         proxy %>% addPolygons(color = "#444444" ,
                              weight = 1, 
                              smoothFactor = 0.5,
                              opacity = 1.0,
                              fillOpacity = 0.5,
                              popup = popup1 ,
                              fillColor = ~pal(dat1[[input$option]]))%>% 

            addLegend(position = "topright", pal = pal , values = dat1[[input$option]] ,
                      title =  ~paste(input$option)) }

    else  if (input$option  == "Población Femenina") {

        proxy %>% addPolygons(color = "#444444" ,
                              weight = 1, 
                              smoothFactor = 0.5,
                              opacity = 1.0,
                              fillOpacity = 0.5,
                              popup = popup1 ,
                              fillColor = ~pal(dat1[[input$option]]))%>% 

            addLegend(position = "topright", pal = pal , values = dat1[[input$option]] ,
                      title =  ~paste(input$option)) }

    else  

        proxy %>% addPolygons(color = "#444444" ,
                              weight = 1, 
                              smoothFactor = 0.5,
                              opacity = 1.0,
                              fillOpacity = 0.5,
                              popup = popup1 ,
                              fillColor = ~pal(dat1[[input$option]]))%>% 

        addLegend(position = "topright", pal = pal , values = dat1[[input$option]] ,
                  title =  ~paste(input$option)) 

})

}

闪亮应用（用户界面 = 用户界面，服务器 = 服务器）

于 2020-02-25T21:01:52.757 回答