我正在整理一个包含Leaflet地图的Shiny应用程序。不幸的是，每当我运行它时，它都会产生以下错误：“没有适用于'metaData'的适用方法应用于类“ NULL”的对象”。我很确定错误是由AddLegends功能引起的，因为如果我在删除该部分的情况下运行它，似乎工作正常。不太确定我在做什么错，因为我正在按照我在AddPolygons中使用的相同步骤进行操作，就像我说的那样，这似乎还可以。
在另一个问题上，是否有一种方法可以使地图在每次使用新指标时都不再重置？
library(leaflet)
library(sf)
library(dplyr)
library(shiny)
library(shinyWidgets)
library(RColorBrewer)
samples <- st_read("sample_shape.shp")
territory <- samples %>% st_buffer(0) %>% group_by(territory) %>% summarise_if(is.numeric, sum)
territory_field <- samples %>% st_buffer(0) %>% group_by(territory,field) %>% summarise_if(is.numeric, sum)
territory_field_coverage <- samples %>% st_buffer(0) %>% group_by(territory, field, coverage) %>% summarise_if(is.numeric, sum)
county <- samples %>% st_buffer(0) %>% group_by(county) %>% summarise_if(is.numeric, sum)
district <- samples %>% st_buffer(0) %>% group_by(district) %>% summarise_if(is.numeric, sum)
metrics_list <- c(samples %>% st_drop_geometry() %>% dplyr::select_if(is.numeric) %>% colnames())
ui <- fluidPage(
fluidRow(
column("",
width = 10, offset = 1,
tags$h3("Select"),
panel(
selectizeInput('counties', label = 'County', multiple = TRUE, c(unique(sort(county$county)))),
selectizeInput('cds', label = 'District', multiple = TRUE, c(unique(sort(district$district)))),
selectizeInput('territories', label = 'Territory', multiple = TRUE, c(unique(sort(territory$territory)))),
uiOutput("field"),
uiOutput("coverage"),
selectInput("metric", label = 'Select Metric', choices = metrics_list, selected = "sales"),
checkboxInput("allCoverages", "See All Coverage", TRUE)
),
leafletOutput(outputId = "map", height = "600")
)
)
)
server <- function(input, output, session) {
output$field <- renderUI({
selectizeInput("fields", "Field", multiple = TRUE, c(unique(sort(territory_field$field[territory_field$territory == input$territories]))))
})
output$coverage <- renderUI({
selectizeInput("coverages", "Coverage", multiple = TRUE, c(unique(sort(territory_field_coverage$coverage[territory_field_coverage$field == input$field]))))
})
map_data <- reactive({
if(!is.null(input$territories)
& is.null(input$fields)
& is.null(input$coverages)
& (is.null(input$counties) | !is.null(input$counties))
& (is.null(input$cds) | !is.null(input$cds)))
res <- territory_field %>% filter(territory %in% input$territories)
else
if(!is.null(input$fields)
& is.null(input$coverages)
& (is.null(input$counties) | !is.null(input$counties))
& (is.null(input$cds) | !is.null(input$cds))
& input$allCoverages == FALSE)
res <- territory_field_coverage %>% filter(field %in% input$fields)
else
if(!is.null(input$coverages)
& (is.null(input$counties) | !is.null(input$counties))
& (is.null(input$cds) | !is.null(input$cds))
& input$allCoverages == FALSE)
res <- territory_field_coverage %>% filter(coverage %in% input$coverages)
else
if(is.null(input$territories)
& is.null(input$fields)
& is.null(input$coverages)
& is.null(input$counties)
& is.null(input$cds)
& input$allCoverages == FALSE)
res <- territory %>% group_by(territory)
else
if(!is.null(input$counties)
& is.null(input$territories)
& is.null(input$fields)
& is.null(input$coverages)
& is.null(input$cds)
& input$allCoverages == FALSE)
res <- county %>% filter(county %in% input$counties)
else
if(!is.null(input$cds)
& is.null(input$territories)
& is.null(input$fields)
& is.null(input$coverages)
& is.null(input$counties)
& input$allCoverages == FALSE)
res <- district %>% filter(district %in% input$cds)
else
if(!is.null(input$cds)
& is.null(input$territories)
& is.null(input$fields)
& is.null(input$coverages)
& !is.null(input$counties)
& input$allCoverages == FALSE)
res <- district %>% filter(district %in% input$cds)
else
if(input$allCoverages == TRUE
& (is.null(input$territories) | !is.null(input$territories))
& (is.null(input$fields) | !is.null(input$fields))
& (is.null(input$coverages) | !is.null(input$coverages))
& (is.null(input$cds) | !is.null(input$cds))
& (is.null(input$counties) | !is.null(input$counties)))
res <- territory_field_coverage %>% filter(is.null(input$territories) | territory %in% input$territories,
is.null(input$fields) | field %in% input$fields,
is.null(input$coverages) | coverage %in% input$coverages)
res
})
output$map <- renderLeaflet({
req(input$metric)
res <- map_data()
map <- leaflet() %>%
addProviderTiles(provider = "CartoDB.Positron",
providerTileOptions(detectRetina = FALSE,
reuseTiles = TRUE,
minZoom = 4,
maxZoom = 8))
map %>% draw_demographics(input, res)
})
getpal <- function(cpop,nmax){
if (length(cpop)>1){
# try out value from nmax down to 1
for (n in nmax:1){
qpct <- 0:n/n
cpopcuts <- quantile(cpop,qpct)
# here we test to see if all the cuts are unique
if (length(unique(cpopcuts))==length(cpopcuts)){
if (n==1){
# The data is very very skewed.
# using quantiles will make everything one color in this case (bug?)
# so fall back to colorBin method
return(colorBin("YlOrRd",cpop, bins=nmax))
}
return(colorQuantile("YlOrRd", cpop, probs=qpct))
}
}
}
# if all values and methods fail make everything white
pal <- function(x) { return("white") }
}
draw_demographics <- function(map, input, data) {
cpop <- data[[input$metric]]
if (length(cpop)==0) return(map) # no pop data so just return (much faster)
pal <- getpal(cpop,7)
map %>%
clearShapes() %>%
addPolygons(data = data,
fillColor = ~pal(cpop),
fillOpacity = 1,
color = "#BDBDC3",
weight = 3) %>% addLegend("bottomright",
pal = ~pal(cpop),
values = ~cpop,
title = "Sales",
opacity = 1)
}
}
shinyApp(ui,server)