基于inputpicker的动态彩色圆圈标记

时间:2020-10-21 03:45:20

标签: r shiny leaflet

我使用inputpicker作为输入,而我没有设置选择的最大数量,而是尝试添加圆标记并根据输入区分颜色。到目前为止,我能做的是制作一个具有相同颜色的圆圈标记的图。

反正有得到我想要的东西吗?

到目前为止,我的代码是

#create dummy table
site_list <- data.frame(
  site_key = c(1:5),
  site_name = LETTERS[1:5],
  longitude = c(106.821925,
                110.366203,
                106.807781,
                106.790449,
                106.829174),
  latitude = c(-6.195746,
               -7.79295,
               -6.601264,
               -6.127774,
               -6.280346)
  
)

cust_geo_code <- data.frame(
  site_key = c(1:5),
  site_name = LETTERS[1:5],
  longitude = c(106.8215561,
                109.2068481,
                106.798018,
                106.76744,
                106.83137),
  latitude = c(-6.330375195,
               -6.869058132,
               -6.288083,
               -6.19817,
               -6.29577)
  )
                
  )
)
# UI
ui = bootstrapPage(
  leafletOutput("mymap", width = "100%", height = "100%"),
  absolutePanel(top = 10, right = 100,
                pickerInput(
                  inputId = "site", 
                  label = "Site Selection", 
                  choices = site_list$site_name, 
                  selected = site_list$site_name[1],
                  options = list(
                    `actions-box` = TRUE, 
                    size = 5,
                    `selected-text-format` = "count",
                    `live-Search` = TRUE
                  ), 
                  multiple = TRUE
                )
                
  )
)
# server
server = function(input, output) {
  
  output$mymap <- renderLeaflet({
    leaflet() %>% 
      addTiles() %>% 
      addProviderTiles(providers$CartoDB.Positron) %>% 
      addControl(title, position = "topleft", className="map-title")
    
  }) 

  observe({
    factpal <- colorFactor("Set1", 
                           domain = input$site)
    # customer_number <- tbl(con,in_schema("dbo", "DimCardNumber")) %>% select(DimCardNumberKey, CardNumber)
    
    # From power BI filter dim_site_key == 89
    site = input$site

    site_key_number = site_list$site_key
    
    site_geocode <- site_list %>% filter(site_name %in% site)
    customer_geocode <- cust_geo_code %>% filter(site_name %in% site)

    leafletProxy("mymap") %>% 
      clearShapes() %>% 
      addMarkers(lng =site_geocode$longitude, lat = site_geocode$latitude,popup = site_geocode$site_name) %>% 
      addCircleMarkers(lng =customer_geocode$longitude, lat = customer_geocode$latitude,
                       radius = 5, fillOpacity = 7, fillColor = ~factpal(eval(input$site)), weight = 1
      )
  })
}  


shinyApp(ui = ui, server = server)

此代码未运行,因为我不知道该怎么做才能修复此代码。 你们可以帮我吗?

0 个答案:

没有答案