В вашем коде было несколько ошибок, отсутствующие метки были просто незначительной проблемой.
Прежде всего, вы можете поместить все нереактивные значения вне функции сервера и, возможно, вам следует сохранить confini. * shapefiles в RDS-файл или БД и загрузить их оттуда.Я предполагаю, что это ускорит ваше приложение.
Ваш листовой график никогда не показывался, потому что вы визуализировали объект mappa () в выходной ID = Mappa.ASL.Реактивная маппа, тем не менее, не создает карту, так как она не возвращает карту или какой-либо объект, поэтому вы должны изменить reactive на observer.LeafletProxy просто добавляет материал на исходную карту (в вашем случае mappa.base), который вы никогда не использовали в пользовательском интерфейсе.
Ваша ошибка произошла из-за вызова labels = labels() в addPolygons, как если бы метки были реактивным объектом, но вы определили его в той же реактивной среде, поэтому вы вызываете его без скобок, например:
labels = labels
Вместо того, чтобы делать реактивные значения из них:
anno.map <- reactive({input$Anno.map})
pat.map <- reactive({input$Patologia.map})
pat.map.p <- reactive({paste0(pat.map(), "p")})
Вы можете просто использовать их в качестве реактивов, таких как:
input$Anno.map
input$Patologia.map
paste0(pat.map(), "p")
Я бы также не использовал реактив (map), который всегда считывает шейп-файл с диска и сразу же перепроектирует его.Можете ли вы объединить их вместе в один шейп-файл, а затем отфильтровать и перепроектировать их заранее, чтобы вам не приходилось делать это каждый раз, когда вызывается приложение?
Следующее приложение должно работать.По крайней мере, немного, так как вы будете работать с ошибками в функции colorQuantile, как эта, поскольку в наборах данных есть значения NA (например, годы 2009-2006 для 'SIST_NERV')
Предупреждение: Ошибка в cut.default: 'breaks' не являются уникальными
Вы можете просто изменить colorQuantile на colorBin и удалить аргумент n = 6.
require(shiny)
require(stringr)
require(shinythemes)
require(leaflet)
require(RColorBrewer)
require(rgdal)
require(rgeos)
# NOT REACTIVE
confini.comuni <- readOGR(dsn = "shapes/originali", layer = "rt.confini.comunali", stringsAsFactors = FALSE)
confini.comuni.WGS84 <- spTransform(confini.comuni, CRS("+proj=longlat +datum=WGS84 +no_defs"))
confini.zone <- readOGR(dsn = "shapes/originali", layer = "rt.confini.exasl", stringsAsFactors = FALSE)
confini.zone.WGS84 <- spTransform(confini.zone, CRS("+proj=longlat +datum=WGS84 +no_defs"))
confini.asl <- readOGR(dsn = "shapes/originali", layer = "rt.confini.asl", stringsAsFactors = FALSE)
confini.asl.WGS84 <- spTransform(confini.asl, CRS("+proj=longlat +datum=WGS84 +no_defs"))
#### UI ####
ui <- {fluidPage(
theme = shinytheme("spacelab"),
titlePanel("Indice"),
navlistPanel(
tabPanel(title = "Mappe",
fluidRow(column(6, sliderInput(inputId = "Anno.map",
label = "Anno di manifestazione",
min = 2000, max = 2016, value = 2016, step = 1,
ticks = FALSE, sep = "")),
column(6, selectInput(inputId = "Patologia.map",
label = "Patologia", choices = list("SIST_NERV", "MESOT","TUM_RESP"),
selected = "SIST_NERV", multiple = FALSE))),
fluidRow(column(6,
leafletOutput(outputId = "mappa.base", height = "600px", width = "100%")
))
)
)
)}
#### SERVER ####
server <- function(input, output) {
# REACTIVE
map <- reactive({
req(input$Anno.map)
spTransform(readOGR(dsn = "shapes/zone", layer = paste0("zone_", input$Anno.map), stringsAsFactors = FALSE),
CRS("+proj=longlat +datum=WGS84 +no_defs"))
})
output$mappa.base <- renderLeaflet({
leaflet(options = leafletOptions(zoomControl = FALSE, dragging = FALSE,
minZoom = 7.5, maxZoom = 7.5)) %>%
addTiles() %>%
addPolygons(data = confini.comuni.WGS84,
weight = 1, opacity = 1, color = "black") %>%
addPolygons(data = confini.zone.WGS84,
weight = 2, opacity = 1, color = "black")
})
map.df <- reactive({
req(input$Anno.map)
map() %>%
as.data.frame() %>%
dplyr::select(EXASLNOME, input$Patologia.map, paste0(input$Patologia.map, "p"))
})
mappa <- observe({
pal <- colorQuantile(palette = "YlOrRd", domain = map.df()[,2],
n = 6, na.color = "808080",
alpha = FALSE, reverse = FALSE,
right = FALSE)
labels <- sprintf("<strong>%s</strong> <br/> %d Segnalazioni <br/> %d con nesso positivo",
map.df()[,1], map.df()[,2], map.df()[,3]) %>% lapply(htmltools::HTML)
leafletProxy(mapId = "mappa.base", data = map()) %>%
addPolygons(fillColor = ~pal(map.df()[,2]),
weight = 2,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7,
highlight = highlightOptions(weight = 5,
color = "666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE),
label = labels
)
})
}
# Run the application
shinyApp(ui = ui, server = server)