Блог

Я изо всех сил пытался создать легенду динамических карт на картах R Shiny Leaflet. Идея состоит в том, чтобы иметь код шаблона, поэтому всякий раз, когда данные меняются, карта и ее легенда будут следовать. Координата уже может корректироваться с изменением данных, но все еще не знаю, как сделать легенду динамической

Вот код

test_map.csv содержит список данных
dat_map <- read.csv("data_input/test_map.csv", header = T)

Это для пользовательского интерфейса. где есть входные данные для доступа к определенным данным в test_map.csv, которые я назвал «querymap»

       tabItem(tabName = "maps",
          fluidRow(
             
             sidebarPanel(width = 4,
                          selectInput("querymap","Title:",dat_map$Title),
                          strong("Description:"), textOutput("captionmap"), br(),
                          strong("Reference:"), uiOutput("referencemap"), #textOutput("reference"), 
                          em(textOutput("latestmap")), br(),
                          strong("Tags: "), verbatimTextOutput("tagsmap")),
             mainPanel(
                h2(textOutput("dinTitlemap")),
                tabsetPanel(
                   tabPanel("Map",br(),leafletOutput("mapall")),
                   tabPanel("Table", br(), DT::dataTableOutput("dinTablemap")), 
                   tabPanel("Download", br(), downloadButton("dlTablemap", label = "Download Table"))
                )))))
  

Это «реактивный» способ получения данных из test_map.csv

     db_map <- reactive({
   filename <- dat_map$Filename[dat_map$Title == input$querymap]
   db_map <- read.csv(paste("data_input/", filename, sep = "")) %>% 
      select(-No)
   db_map})
  

И вот выходной код

 output$mapall <- renderLeaflet({
db_map <- db_map ()

  pal <- colorFactor(
     palette = c('red', 'blue', 'yellow', 'orange','grey','green'),
     domain = db_map$kategori) #pallete for coordinate and legend color
  
  addLegendCustom <- function(map, colors, labels, sizes, opacity = 0.8){
     colorAdditions <- paste0(colors, "; width:", sizes, "px; height:", sizes, "px")
     labelAdditions <- paste0("<div style='display: inline-block;height: ",
                              sizes, "px;margin-top: 4px;line-height: ",
                              sizes, "px;'>", labels, "</div>")
     
     return(addLegend(map, title = "Category", colors = colorAdditions,
                      labels = labelAdditions, opacity = opacity, position = "bottomleft"))}
  
  leaflet(options = leafletOptions(zoomControl = FALSE, minZoom = 3, maxZoom = 100), data = db_map) %>% 
     fitBounds(min(db_map$long),min(db_map$lat),max(db_map$long),max(db_map$lat)) %>%
     addTiles('http://{s}.basemaps.cartocdn.com/light_all/{z}/{x}/{y}.png', group = "CartoDB Light") %>% 
     addCircleMarkers(
        radius = 7, 
        color = 'black',
        stroke = TRUE, weight = 1,
        fillOpacity = 0.7,
        fillColor = ~pal(kategori),
     )%>%
     kategori = as.factor(db_map$kategori) %>%
     addLegendCustom(colors = ~pal, labels = db_map$kategori, sizes = c(10,10,10)) %>% #here is the problem
     })
  

Тогда ошибка «Ошибка: ‘цвета’ и ‘метки’ должны быть одинаковой длины»

Да, я знаю, что это не одинаковой длины, потому что палитра цветов настроена на 6 цветов, но метки зависят от количества переменных в db_map $ kategori. Итак, мой вопрос в том, как создать одинаковую длину цветов с метками?

Заранее благодарю вас

Вы можете сделать, как показано ниже. При необходимости добавьте больше цветов в свой список.

 output$mapall <- renderLeaflet({
    db_map <- db_map()
    
    numcolor = length(unique(db_map$kategori))
    mycolor <- c("red", "blue", "black", "brown", "purple", "green", "darkblue", "darkgreen", "orange", "maroon", "yellow", "cyan","grey")
    pal <- mycolor[1:numcolor]  ##  this ensures that you have the same length of colors as labels
    
    # pal <- colorFactor(
    #   palette = c('red', 'blue', 'yellow', 'orange','grey','green'),
    #   domain = db_map$kategori) #pallete for coordinate and legend color
    
.
.
.
})