renderLeaflet：图例值未更新答案

【问题标题】：renderLeaflet: legend values are not updatedrenderLeaflet：图例值未更新
【发布时间】：2018-11-04 16:01:21
【问题描述】：

我在闪亮的框架中有以下 R 代码。一切看起来都不错，但传说（Plese see this screenshot）。我希望根据用户选择的年龄组（60+、65+、85+）、性别或年份来更新图例。但事实并非如此。也就是说，无论从左侧菜单中选择什么 (Please see this screenshot)，图例的值都保持不变。如果选择了 85+，这会使地图无用。以下是我的全部代码。
我感谢您的帮助。纳德

load("/Users/nadermehri/Desktop/map codes/nhmap.RData")

library(shiny)
library(leaflet)

ui <- fluidPage(
tabPanel(
  "Interactive Maps",

  tags$h5 (
  )),
  br(),

  sidebarLayout(
    sidebarPanel(
      selectInput(
        inputId = "Age_Group_map",
        label = "Select the Age Group:",
        selected = "60+",
        selectize = F,
        multiple = F,
        choices = sort(unique(nhmap$Age_Group))
      ),


      radioButtons(
        inputId = "sex_map",
        label = strong("Select Sex:"),
        selected = "Both Sexes",
        choices = sort(unique(nhmap$Sex))
      ),

      sliderInput(
        inputId = "Year_map",
        label = "Year",
        min = 2010,
        max = 2050,
        value = 2010,
        step = 10,
        sep = "",
        pre = "",
        animate = animationOptions(
          interval = 1000,
          loop = F,
          playButton = tags$button("Play", style =
                                     "background-color: #B61E2E ; color:white; margin-top: 10px; border:solid"),
          pauseButton = tags$button("Pause", style =
                                      "background-color: #B61E2E !important; color:white; margin-top: 10px; border:solid")
        ),
        round = T,
        width = "150%",
        ticks = T
      )),

mainPanel("Interactive", leafletOutput("int_map", height=500))))

server <- function(input, output) {


    mapdata_ <- reactive ({

      nhmap$Per <- round(nhmap$Per, 1) 

      out_map <- nhmap %>%
        filter (
          Age_Group %in% input$Age_Group_map,
          Sex %in% input$sex_map,
          Year %in% input$Year_map)


      return(out_map)
    })


    output$int_map <- renderLeaflet ({


      leaflet (mapdata_(),

               pal8 <- c("#FFFFE5", "#D9F0A3", "#78C679", "#006837") ,
               pal <- colorBin(palette = pal8, domain = NULL, bins=quantile(nhmap$Per), na.color = "#808080",  alpha = FALSE, reverse = F)) %>%



        addProviderTiles("CartoDB.Positron") %>% 
        clearControls() %>%
        clearShapes()%>%
        addPolygons(fillColor = ~pal(Per),
                    stroke=T,
                    weight=1,
                    smoothFactor=0.2,
                    fillOpacity = 1,
                    color="black",
                    popup=~paste(NAME,"<br>",input$sex_map,
                                 input$Age_Group_map,"=",Per,"%"),
                    highlightOptions = highlightOptions(color = "red",
                                                        weight = T,
                                                        bringToFront = T),

                    label=~NAME) %>%


        addTiles() %>%

        setView(-82.706838, 40.358615, zoom=7) %>%

        addLegend(position = "bottomright",
                  values = ~Per,
                  pal = pal,
                  title = (paste("%",input$Age_Group_map, input$sex_map, "in", input$Year_map)) ,
                  labFormat = labelFormat(
                  ))

    })
}

shinyApp(ui = ui, server = server)

【问题讨论】：

您能否也分享您的数据（与dput(nhmpa)）并将您的代码扩展到一个完全可重现的示例？您也不想在传单调用中创建 pal8 和 pal。

标签： r shiny legend r-leaflet

【解决方案1】：

您必须在 colorBin 中定义 bin，您要在这些 bin 中剪切不同颜色部分的数据。比如：

pal <- colorBin(palette = pal8, domain = NULL, bins=quantile(mapdata_()$Per),
                na.color = "#808080",  alpha = FALSE, reverse = F)

您还必须从addLegend 调用中删除bins= 4，因为它会从调色板中获取信息。

我为nhmap 创建了一些随机数据，它对我有用：

library(shiny)
library(leaflet)
library(sf)
library(sp)

## Random Data #############
data(meuse, package = "sp")
nhmap <- st_as_sf(meuse, coords = c("x", "y"))
st_crs(nhmap) <- "+init=epsg:28992"
nhmap <- st_buffer(nhmap, 100)

n = length(nhmap$cadmium)
nhmap$Age_Group <- sample(c(15,19,25), size = n, T)
nhmap$Sex <- sample(c("m","f"), size = n, T)
nhmap$Per <- runif(n, 1, 150)
nhmap$NAME <- sample(c("a","b","c"), size = n, T)
nhmap$Age_Group <- sample(c(15,19,25), size = n, T)
nhmap$Year <- sample(c(2010,2020,2030, 2040, 2050), size = n, T)
nhmap <- st_transform(nhmap, 4326)


## UI ###########
ui <- {fluidPage(
  tabPanel(
    "Interactive Maps",
    tags$h5 ()),
  br(),

  sidebarLayout(
    sidebarPanel(
      selectInput(
        inputId = "Age_Group_map",
        label = "Select the Age Group:",
        # selected = "60+",
        selectize = F,
        multiple = F,
        choices = sort(unique(nhmap$Age_Group))
      ),


      radioButtons(
        inputId = "sex_map",
        label = strong("Select Sex:"),
        # selected = "Both Sexes",
        choices = sort(unique(nhmap$Sex))
      ),

      sliderInput(
        inputId = "Year_map",
        label = "Year",
        min = 2010,
        max = 2050,
        value = 2010,
        step = 10,
        sep = "",
        pre = "",
        animate = animationOptions(
          interval = 1000,
          loop = F,
          playButton = tags$button("Play", style =
                                     "background-color: #B61E2E ; color:white; margin-top: 10px; border:solid"),
          pauseButton = tags$button("Pause", style =
                                      "background-color: #B61E2E !important; color:white; margin-top: 10px; border:solid")
        ),
        round = T,
        width = "150%",
        ticks = T
      )),

    mainPanel("Interactive", leafletOutput("int_map", height=500)))
)}

## SERVER ###########
server <- function(input, output) {

  mapdata_ <- reactive ({
    nhmap$Per <- round(nhmap$Per, 1)
    # nhmap
    nhmap %>%
      filter (
        Age_Group %in% input$Age_Group_map,
        Sex %in% input$sex_map,
        Year %in% input$Year_map)
  })

  output$int_map <- renderLeaflet ({
    req(mapdata_())
    pal8 <- c("#FFFFE5", "#D9F0A3", "#78C679", "#006837")
    # pal <- colorBin(palette = pal8, domain = NULL, bins=quantile(mapdata_()$Per), 
    pal <- colorBin(palette = pal8, domain = NULL, bins=quantile(nhmap$Per), 
                    na.color = "#808080",  alpha = FALSE, reverse = F)


    leaflet(data = mapdata_()) %>%
      # leaflet(data = nhmap) %>% 
      clearControls() %>%
      clearShapes()%>%
      addProviderTiles("CartoDB.Positron") %>% 
      addTiles() %>%
      addPolygons(fillColor = ~pal(Per),
                  stroke=T,
                  weight=1,
                  smoothFactor=0.2,
                  fillOpacity = 1,
                  color="black",
                  label=~NAME,
                  popup=~paste(NAME,"<br>",input$sex_map,
                               input$Age_Group_map,"=",Per,"%"),
                  highlightOptions = highlightOptions(color = "red",
                                                      weight = T,
                                                      bringToFront = T)) %>%

      # setView(-82.706838, 40.358615, zoom=7) %>%

      addLegend(position = "bottomright",
                values = ~Per,
                title = (paste("%",input$Age_Group_map, input$sex_map, "in", input$Year_map)),
                pal = pal
      )
  })
}

shinyApp(ui = ui, server = server)

【讨论】：

我在我的 R studio 控制台中运行了 "dput(nhmap, file="nhmap")。我猜你现在可以访问数据了。我还将整个闪亮的代码放在上面的灰色框中。如果您可以访问数据，它是完全可重现的。感谢您的进一步帮助。
您必须在问题中包含dput(nhmap) 的输出，然后我们才能导入您的数据。不过不管怎样，我的回答能解决你的问题吗？
是的，确实如此。但是，出现了一个新问题，我在正文中（灰色框上方）进行了解释。我假设您可以通过运行 dget("nhmap") 访问我的数据。我还在正文中发布了整个代码。
你没有包含dput(nhmap)的输出，所以我无法导入你的数据。
请试试这个：dget("nhmap.txt")

【解决方案2】：

这就是答案。正如我在上一条评论中提到的，朋友需要反应：

mapdata_ <- reactive ({



 nhmap$Per <- round(nhmap$Per, 1) 

 out_map <- nhmap %>%
   filter (
     Age_Group %in% input$Age_Group_map,
      Sex %in% input$sex_map,
     Year %in% input$Year_map)

 return(out_map)
 list(Per)



})

  mapdata_1 <- reactive ({



nhmap$Per <- round(nhmap$Per, 1) 

out_map_1 <- nhmap %>%
  filter (
    Age_Group %in% input$Age_Group_map
    )

return(out_map_1)
list(Per)



})



  output$int_map <- renderLeaflet ({

pal8 <- c("#FFFFE5", "#D9F0A3", "#78C679", "#006837") 
pal <- colorBin(palette = pal8, domain =NULL, bins=quantile(mapdata_1()$Per), na.color = "#808080",  alpha = FALSE, reverse = F)

 leaflet (mapdata_()) %>% 
                    addProviderTiles("CartoDB.Positron") %>% 
                 clearControls() %>%
                 clearShapes()%>%
                    addPolygons(fillColor = ~pal(Per),
                               stroke=T,
                               weight=1,
                               smoothFactor=0.2,
                               fillOpacity = 1,
                               color="black",
                               popup=~paste(NAME,"<br>",input$sex_map,
                                            input$Age_Group_map,"=",Per,"%"),
                                highlightOptions = highlightOptions(color = "red",
                                                                    weight = T,
                                                                    bringToFront = T),

                               label=~NAME) %>%


                               addTiles() %>%

  setView(-82.706838, 40.358615, zoom=7) %>%

                    addLegend(position = "bottomright",
                     values = ~Per,
                     pal = pal,
                     title = (paste("%",input$Age_Group_map, input$sex_map, "in", input$Year_map)) ,
                   labFormat = labelFormat(
                  ))

    })

【讨论】：