Question

我有一个按城市分类的医疗咨询数据库。我使用leaflet和state_popup函数在地图上显示结果，如下所述：

pal <- colorBin("Blues",domain = DATA$QUANTITY_MEDICAL,bins = c(1, 1000, 5000, 10000, 50000,100000,300000),na.color=NA) 

state_popup <- paste0("<strong>CITY: </strong>", 
                      DATA$CITY, 
                      "<br><strong> QUANTITY OF MEDICAL CONSULTATION: </strong>", 
                      DATA$QUANTITY_MEDICAL)

leaflet(data = DATA) %>%
    addProviderTiles("CartoDB.Positron") %>%
    addPolygons(fillColor = ~pal(QUANTITY_MEDICAL), 
                fillOpacity = 0.7, 
                color = "#BDBDC3", 
                weight = 1, 
                popup = state_popup) %>%
    addLegend("topright","bottomright", pal = pal, values = ~ DATA$QUANTITY_MEDICAL,
              title = " QUANTITY OF MEDICAL CONSULTATION ",
              opacity = 1)

此脚本一次仅显示一个结果（医疗咨询）。我想提供有关我想包括的其他医疗程序的信息，例如检查或住院。我希望为每个过程（医学咨询，检查或住院治疗）提供一个可以更改结果的按钮。在我的数据库（DATA）中，我已经有分开引用的过程的列。是否可以包含此按钮来更改地图上的结果？

Answer 1

在我看来，您将必须定义组。 RStudio的传单上有一个很好的链接，可能对您有帮助。

https://rstudio.github.io/leaflet/showhide.html

以下是该站点的一些示例代码：

quakes <- quakes %>%
  dplyr::mutate(mag.level = cut(mag,c(3,4,5,6),
                                labels = c('>3 & <=4', '>4 & <=5', '>5 & <=6')))

quakes.df <- split(quakes, quakes$mag.level)

l <- leaflet() %>% addTiles()

names(quakes.df) %>%
  purrr::walk( function(df) {
    l <<- l %>%
      addMarkers(data=quakes.df[[df]],
                          lng=~long, lat=~lat,
                          label=~as.character(mag),
                          popup=~as.character(mag),
                          group = df,
                          clusterOptions = markerClusterOptions(removeOutsideVisibleBounds = F),
                          labelOptions = labelOptions(noHide = F,
                                                       direction = 'auto'))
  })

l %>%
  addLayersControl(
    overlayGroups = names(quakes.df),
    options = layersControlOptions(collapsed = FALSE)
  )

我有一个每月更新的地图，其中包含层层信息，我会这样获知：

lsl <- unique(origAddress$LIHN_Line) # Gets unique service lines
# Create color palette
lihnpal <- colorFactor(
  palette = 'Dark2'
  , domain = origAddress$LIHN_Line
)
# create initial leaflet
LIHNMap <- leaflet() %>%
  setView(lng = sv_lng, lat = sv_lat, zoom = sv_zoom) %>%
  addTiles(group = "OSM (default)") %>%
  addProviderTiles(providers$Stamen.Toner, group = "Toner") %>%
  addProviderTiles(providers$Stamen.TonerLite, group = "Toner Lite") %>%
  addControl("LIHN Service Line Point Map", position = "topright")

# for loop to cycle through adding layers
for(i in 1:length(lsl)){
  LIHNMap <- LIHNMap %>%
    addCircles(
      data = subset(origAddress, origAddress$LIHN_Line == lsl[i])
      , group = lsl[i]
      , lat = ~lat
      , lng = ~lon
      , radius = 3
      , fillOpacity = 1
      , color = ~lihnpal(LIHN_Line)
      , label = ~htmlEscape(LIHN_Line)
      , popup = ~as.character(
        paste(
          "<strong>Hospitalist/Private: </strong>"
          , hosim
          , "<br><strong>Address: </strong>"
          , FullAddress
          , "<br><strong>Service Line: </strong>"
          , LIHN_Line
          , "<br><strong>LOS: </strong>"
          , LOS
          , "<br><strong>SOI: </strong>"
          , SOI
          , "<br><strong>Encounter: </strong>"
          , pt_id
          , "<br><strong>Payer Group:</strong>"
          , pyr_group2
        )
      )
    )
}

# add layercontrol
LIHNMap <- LIHNMap %>%
  addLayersControl(
    baseGroups = c("OSM (default)", "Toner", "Toner Lite"),
    overlayGroups = lsl,
    options = layersControlOptions(
      collapsed = TRUE
      , position = "topright"
    )
  )

LIHNMap <- LIHNMap %>%
  addAwesomeMarkers(
    lng = sv_lng
    , lat = sv_lat
    , icon = hospMarker
    , label = ""
    , popup = HospPopup     
  )

# print map
LIHNMap

使用传单和state_popup交换地图结果

1 个答案: