addlegend R Листовка, основанная на вводе пользователем

Question

Я использую функцию Shiny varSelectInput для отображения карты с буклетом R из пространственного полигона, так что, выбрав переменную объекта, рисуется карта соответствующей переменной, и я меняю ее цвет. Для этого я сгенерировал реактивный объект функции ColorBin буклета R из условной переменной varSelectInput. Все это при рендеринге карты работает корректно и поэтому карта раскрашивается, обновляя цвет и заголовок легенды. Однако при развертывании легенды (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)

Answer 1

Здравствуйте, после нескольких попыток я достиг этого решения:

библиотека (блестящая) библиотека (листовка) библиотека (leaflet.extras)

load ("./ Datos.Rdata")

ui <- fluidPage (titlePanel ("Santia go de Compostela"), </p>

mainPanel(

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

server <- функция (вход, выход) {</p>

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)) 

})

}

блестящее приложение (пользовательский интерфейс = сервер, сервер = сервер)