Обмен результатами карты с использованием листовки и state_popup

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