Цвет Маркеркластеров

Я хотел бы изменить цвет markerclusters (тот же цвет для всех кластеров). Поэтому я включил этот markerclusteroption:

       iconCreateFunction=JS("function (cluster) {    
       childCount = cluster.getChildCount();  
       if (childCount < 1000) {  
       c = 'rgba(240, 194, 12, 0.7);'
       c = 'rgba(240, 194, 12, 0.7);'  
       }    
       return new L.DivIcon({
             html: '<div style="background-color:'+c+' "><span>' +
             childCount + '</span></div>', className: 'marker-cluster',  
             iconSize: new L.Point(40, 40) });
      }"))

Без этого кода приложение работает, но после включения маркеров не кластер больше. Я использовал эту функцию iconCreateFunction для другого сценария, и он работал хорошо.

library(data.table)
library(shiny)
library(dplyr)
library(leaflet)


mydat <- data.table( id=c(1,2,3,4),
                 londd=c(20, 38, 96, 32),
                 latdd=c(60, 56, 30, 31),
                 material=c("stone", "water,sand", "sand", "wood"),
                 application=c("a","b","c","d"))

#Set up ui
ui <- shinyUI(fluidPage(
  sidebarPanel(h5("", width=2),
           checkboxGroupInput(inputId="MatFlag",label=h4("Material"),                                                 
           choices=setNames(object=c("stone","water","sand", "wood"),
                                nm=c("stone", "water", "sand", "wood")),
           ),
           checkboxGroupInput(inputId="AppFlag",label=h4("Application"), 
                              choices=setNames(object=c("a","b","c","d"),
                                               nm=c("a","b","c","d")),
           ),
           position="left"),

#App mainPanel content and styles
mainPanel(fluidRow(leafletOutput(outputId="lmap")))
))

#Set up server
server <- function(input, output){
  #Build leaflet map
  lmap <- leaflet(data=mydat)%>%
  addProviderTiles("Stamen.TonerLite", 
                 options =providerTileOptions(noWrap = TRUE)) %>%
  fitBounds(~min(londd), ~min(latdd), ~max(londd), ~max(latdd))

#Filter data
datFilt <- reactive({
if (length(input$MatFlag) == 0) filterName <- 'none'
else filterName <- input$MatFlag

print(filterName)
log_mat <- sapply(filterName, function(x) grepl(x, mydat$material))
log_row <- apply(log_mat, 1, any)
mydat[log_row & application %in% input$AppFlag]
})

#Add markers based on selected flags
observe({
if(nrow(datFilt())==0) {
  print("Nothing selected")
  leafletProxy("lmap") %>%
    clearShapes()}
 else{ #print(paste0("Selected: ", unique(input$InFlags&input$InFlags2)))
  leafletProxy("lmap", data=datFilt()) %>% clearShapes() %>%
    clearMarkerClusters() %>% 
    addCircleMarkers(lng=~londd, lat=~latdd,
   clusterOptions=markerClusterOptions(),
          weight=3,
          color="#33CC33", opacity=1, fillColor="#FF9900", 
          fillOpacity=0.8) 
 }
})

output$lmap <- renderLeaflet(lmap)
}

#Run app
shinyApp(ui = ui, server = server)

1 ответ

  1. Возникла проблема с вашим reactiveзвонком datFilt.

    Во-первых, ifelse(length(input$MatFlag) == 0, 'none', input$MatFlag)возвращается только первый выбранный элемент, из-за того, как ifelseработает:

    ifelse возвращает значение с той же формой, что и test

    Второй проблемой было использованиеgrepl, что берет только один элемент для аргумента шаблона, так что даже если вы передаете ему символьный вектор, он будет использовать только первый элемент. Образец:

    grepl(c("stone", "sand"), mydat$material)
    #[1]  TRUE FALSE FALSE FALSE
    #Warning message:
    #In grepl(c("stone", "sand"), mydat$material) :
    #  argument 'pattern' has length > 1 and only the first element will be used
    

    Вместо этого вы должны сделать цикл над элементами, которые будут использоваться в качестве шаблонов. Я выбрал applyсемью. sapplyВыражение (см. раздел код) создает матрицу, показывающую, какие поисковые термины присутствуют в каких строках.

         stone  sand
    [1,]  TRUE FALSE
    [2,] FALSE  TRUE
    [3,] FALSE  TRUE
    [4,] FALSE FALSE
    

    Затем я использовал applyфункцию, чтобы увидеть, какие строки имеют TRUEзначения. e.g: при установке флажка «камень и песок» необходимо выбрать первые 3 строки.

    [1]  TRUE  TRUE  TRUE FALSE
    

    Примечание: должен быть более простой способ сделать эту часть, это только первый, который я придумал.

    Выпуск № 3 Ваш input$AppFlag%in%application. Объект, возвращаемый оператором %in%, имеет длину первого аргумента, и нам нужна такая же длина, как и количество строк в mydat, поэтому следует использовать application %in% input$AppFlag

    См. в Примере:

    c("a", "d") %in% mydat$application
    #[1] TRUE TRUE
    mydat$application %in% c("a", "d")
    #[1]  TRUE FALSE FALSE  TRUE
    

    Рабочий код:

    datFilt <- reactive({
        if (length(input$MatFlag) == 0) filterName <- 'none'
        else filterName <- input$MatFlag
    
        print(filterName)
        log_mat <- sapply(filterName, function(x) grepl(x, mydat$material))
        log_row <- apply(log_mat, 1, any)
        mydat[log_row & application %in% input$AppFlag]
      })