r - AddLegend 基于 r 传单中的反应值

Question

我正在尝试根据用户输入在我的交互式地图应用程序上添加传奇功能，这样当他选择输入范围时，颜色映射会根据所选条件发生变化。

我尝试以这种方式将colorBin()内部reactive()函数放入：

colorpal <- reactive({
        colorBin(palette = "plasma", domain = data_input_ordered()$totale, bins = 6)
    })

而不是以这种方式使用colorpal()inside ：renderLeaflet()

    output$mymap <- renderLeaflet(
        leaflet() %>%
            addProviderTiles(providers$Stamen.Terrain) %>%
            setView(lng = 9.768875, lat = 45.619111, zoom = 9) %>%
            addPolygons(data = province_lonlat,
                        weight = 1,
                        color = "white",
                        fillOpacity = 0.8,
                        fillColor = colorpal(data_input_ordered()$totale),
                        highlight = highlightOptions(weight = 1, 
                                                     color = "#666666",
                                                     fillOpacity = 0.5,
                                                     bringToFront = TRUE
                        ),
                        label =  lapply(labels(), HTML)
            ) %>%
            addLegend(pal = colorpal, 
                      values = data_input_ordered()$totale, 
                      position = "topright", 
                      labFormat = labelFormat(big.mark = ".")
            )
    )

问题是应用程序正在运行，但地图选项卡没有显示任何内容，而是：“错误：参数长度为零

任何人都有修复我的代码以使我的地图正常工作的提示吗？

完整代码在这里：

# APP

library(shiny)
library(shinydashboard)
library(leaflet)
library(rgdal)
library(dplyr)
library(DT)

province <- readOGR("../in/province.shp")
province_lonlat <- spTransform(province, CRS("+proj=longlat +datum=WGS84"))
crimini <- read.csv2("../in/crimini.csv")


### UI

ui <- dashboardPage(
    skin = "blue",
    dashboardHeader(title = "Crimini denunciati nelle province della Lombardia"),
    dashboardSidebar(
        sliderInput(
            # nome per indicare i valori controllati dallo slider (si utilizza nel SERVER per riferirsi ai dati da controllare)
            inputId = "date_range",
            label = "Anno",
            min = min(crimini$anno),
            max = max(crimini$anno),
            # valori iniziali dello slider
            value = c(min(crimini$anno), max(crimini$anno)),
            sep = ".",
            step = 1
            )
    ),
    dashboardBody(
        fluidRow(box(width = 12, leafletOutput(outputId = "mymap"))),
        fluidRow(box(width = 12, dataTableOutput(outputId = "summary_table")))
    )
    
)
    


### SERVER

server <- function(input, output) {
    
    data_input <- 
        # inserisco una funzione REACTIVE che aggiorna il calcolo ogni volta che i parametri di input vengono modificati
        reactive({
            crimini %>%
                # filtro i valori in base al massimo e al minimo selezionati con lo slider
                filter(`anno` >= input$date_range[1]) %>%
                filter(`anno` <= input$date_range[2]) %>%
                group_by(`provincia`) %>%
                summarize("totale" = sum(`n_crimini`),
                          "media annua" = round(sum(`n_crimini`) / (input$date_range[2] - input$date_range[1]), digits = 2)
                          )
        })
    
    data_input_ordered <- reactive({
        data_input()[order(match(data_input()$provincia, province_lonlat$provincia)), ]
    })
    
    labels <- reactive({
        paste("<p>", data_input_ordered()$provincia, "</p>",
              "<p>", "totale crimini: ", data_input_ordered()$totale, "</p>",
              "<p>", "media annua: ", round(data_input_ordered()$`media annua`, digits = 2), "</p>"
              )
    })
    
    colorpal <- reactive({
        colorBin(palette = "plasma", domain = data_input_ordered()$totale, bins = 6)
    })
    
    output$mymap <- renderLeaflet(
        leaflet() %>%
            addProviderTiles(providers$Stamen.Terrain) %>%
            setView(lng = 9.768875, lat = 45.619111, zoom = 9) %>%
            addPolygons(data = province_lonlat,
                        weight = 1,
                        color = "white",
                        fillOpacity = 0.8,
                        fillColor = colorpal(data_input_ordered()$totale),
                        highlight = highlightOptions(weight = 1, 
                                                     color = "#666666",
                                                     fillOpacity = 0.5,
                                                     bringToFront = TRUE
                        ),
                        label =  lapply(labels(), HTML)
            ) %>%
            addLegend(pal = colorpal, 
                      values = data_input_ordered()$totale, 
                      position = "topright", 
                      labFormat = labelFormat(big.mark = ".")
            )
    )
    
    output$summary_table <- renderDataTable(data_input())
    
}
    

文件在这里：https ://drive.google.com/drive/folders/1rL3R5W2cRrX34NDi9bpCphnVGTFcu6s7?usp=sharing

标签： rshinyleafletreactive