Интерактивный буклет с блестящими - clearMarkers () и набор новых - PullRequest
Новая
       106

Интерактивный буклет с блестящими - clearMarkers () и набор новых

0 голосов
/ 21 июня 2020

Я хочу создать интерактивную карту листовок с помощью Shiny. Создание работает нормально, но, несмотря на изменения в selectInput () и нажатии "go!" старые маркеры не удаляются, и новые маркеры не устанавливаются. Не могли бы вы мне помочь?

Операционная система: Windows 10 64-битная версия RStudio R: R версия 4.0.0 

geocodes <- data.frame("customer" = c("John", "Ahmet", "Zara"),
                       "longitude" = c(8.71, 8.59, 8.98),
                       "latitude" = c(51.2, 51.3, 51.1))
# UI
ui <- dashboardPage(
  dashboardHeader(title = "CustomerLocation Dashboard"),
  dashboardSidebar(
    
    selectInput("account", label = "Account",
                choices = c(unique(geocodes$customer)),
                multiple = TRUE),
    
    actionButton("go", "Go!")

  ),

  
  dashboardBody(
    tags$style(type = "text/css", "#map {height: calc(100vh - 80px) !important;}"),
    leafletOutput("mymap", height=1000)
  )
)
  

# server
server <- function(input, output, session){

  reactiveDf <- reactive({
    if(is.null(input$account)){
      geocodes
    } else{
      geocodes[geocodes$customer %in% input$account,]
    }
  })
  
  
  output$mymap <- renderLeaflet({
    leaflet(geocodes) %>%
      addProviderTiles("OpenStreetMap",
                       group = "OpenStreetMap"
      ) %>%
      addAwesomeMarkers(
        lng = ~longitude,
        lat = ~latitude,
        icon = customIcon,
        clusterOptions = markerClusterOptions(),
        label = ~customer,
        popup = ~popup
      )
  })
  
  
  eventReactive(input$go,{
   leafletProxy("mymap", data = reactiveDf()) %>%
      clearShapes() %>%
      clearPopups() %>%
      clearMarkers() %>%
      addAwesomeMarkers(
        data = reactiveDf(),
        lng = ~longitude,
        lat = ~latitude,
        icon = customIcon,
        clusterOptions = markerClusterOptions(),
        label = ~customer,
        popup = ~popup
      )
  })

}

shinyApp(ui, server)

1 Ответ

0 голосов
/ 22 июня 2020

Три исправления, которые я обнаружил:

  1. c(unique(geocodes$customer)) преобразует этот ввод в c(1,2,3). И когда вы позже попробуете подмножество имен клиентов «Джон», «Ахмет» и «Зара» по c (1,2,3) - это несовместимо и не удастся. 
 selectInput("account", label = "Account",
                choices = c(unique(geocodes$customer)),
                multiple = TRUE),

Изменить на: 

selectInput("account", label = "Account",
                choices = unique(geocodes$customer),
                multiple = TRUE),
Я, к сожалению, не знаю, почему clearMarkers() в leafletProxy() не очищает маркеры, как вы ожидаете, но меняет исходную карту с рендеринга с geocodes на reactiveDf() (который по-прежнему возвращает geocodes кадр данных, если input$account равен нулю), похоже, решает эту проблему. 
output$mymap <- renderLeaflet({
    leaflet(geocodes) %>%
      addProviderTiles("OpenStreetMap",
                       group = "OpenStreetMap"
      ) %>%
      addAwesomeMarkers(
        lng = ~longitude,
        lat = ~latitude,
        icon = customIcon,
        clusterOptions = markerClusterOptions(),
        label = ~customer,
        popup = ~popup
      )
  })

Измените на: 

output$mymap <- renderLeaflet({
    leaflet(reactiveDf()) %>%
      addProviderTiles("OpenStreetMap",
                       group = "OpenStreetMap"
      ) %>%
      addAwesomeMarkers(
        lng = ~longitude,
        lat = ~latitude,
        icon = customIcon,
        clusterOptions = markerClusterOptions(),
        label = ~customer,
        popup = ~popup
      )
  })

Если вы хотите немного изменить архитектуру бит:

Используйте observeEvent, чтобы переопределить geocodes в соответствии с input$account и запустить вместе с ним leafletProxy (). Я полагаю, что мы оба упускаем какой-то шаг в отношении создания реактивного фрейма данных для leafletProxy, возможно, мы не можем полностью изменить источник данных, идущий с начального renderLeaflet на leafletProxy? 
observeEvent(input$go, {
    if(is.null(input$account)){
      geocodes = geocodes
    } else{
     geocodes = geocodes[geocodes$customer %in% input$account,]
    }
 leafletProxy("mymap") %>%
    clearShapes() %>%
    clearPopups() %>%
    clearMarkers() %>%
    addMarkers(
      data = geocodes,
      lng = ~longitude,
      lat = ~latitude,
      label = ~customer,
    )
  }
)

Редактировать: Другой вариант - определить группу для каждого слоя маркеров и вызвать showGroup () и hideGroup () для управления визуально отображаемыми маркерами.

Надеюсь, это поможет

...