Question

我想更改markerclusters的颜色（所有簇的颜色相同）。因此我加入了这个markercluster选项：

       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)

Answer 1

您的reactive名为datFilt时出现问题。

首先，由于ifelse(length(input$MatFlag) == 0, 'none', input$MatFlag)的工作原理，ifelse仅返回了第一个选定的项目：

ifelse返回与test
形状相同的值

第二个问题是grepl的使用，它只为pattern参数提供了一个元素，所以即使你传递一个字符向量，它也只会使用第一个元素。例如：

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值。例如：在复选框输入中选中石头和沙子，应选择前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]
  })

Markerclusters的颜色

1 个答案: