selectInput не отвечает на кнопку действия должным образом в моем блестящем приложении карты листовки

Question

Мне нужно создать интерактивную карту с пакетом листовок, где я могу использовать selectInput, чтобы контролировать, какие точки данных показывать на карте. Я также хочу использовать кнопку управления слоями, чтобы выбрать один или оба слоя (точки данных) для отображения на карте. Мой код показан ниже.

Я хочу, чтобы карта отвечала на selectInput только при нажатии кнопки go.

Мой код работает, когда я выбираю один элемент в selectInput (карта обновляется, когда я нажимаю go). Я обнаружил, когда я выбираю второй элемент, изначально я вижу ошибку: subscript out of bounds. При нажатии go появляются оба маркера. Когда я удаляю один из двух выбранных элементов, карта реагирует до нажатия кнопки действия.

Похоже, что selectInput не отвечает на action button должным образом. Кто-нибудь знает, почему это происходит? Что я сделал не так? Я часами пытаюсь понять это, но не повезло ...... Большое спасибо заранее.

library(shiny)
library(leaflet)


hotels <- read.table(text = "Hotel Year  latitude        longitude
                              A   2000  41.886337      -87.628472
                              B   2005  41.88819       -87.635199
                              C   2010  41.891113      -87.63301", 
                     header = TRUE)


ui <- fluidPage(

    selectizeInput(inputId = 'year', label='Choose Year:',
                   choices = c(2000,2005,2010),
                   multiple=TRUE,
                   options = list(
                       maxItems = 2,
                       placeholder = '',
                       onInitialize = I("function() { this.setValue(''); }"))),
    actionButton("go", "go"),
    leafletOutput("mymap")

)

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

    df_list = reactive ({
        input$go

        isolate(
            if (length(input$year)>1) {
                list(hotels[hotels$Year == input$year[1],], 
                     hotels[hotels$Year == input$year[2],])
            } else {
                list(hotels[hotels$Year == input$year[1],])
            }

        )
    })

    output$mymap <- renderLeaflet({

        map = leaflet()  %>%
            addProviderTiles("OpenStreetMap.Mapnik") %>% 
            addCircleMarkers( data = df_list()[[1]] ,
                              group = 'Data Markers 1',
                              lng = ~longitude,
                              lat = ~latitude,
                              radius = 10,
                              stroke = F,
                              fillOpacity = 0.9,
                              color = 'red')
        if ( length(input$year)>1){
            map = map %>% 
                addCircleMarkers( data = df_list()[[2]] ,
                                  group = 'Data Markers 2',
                                  lng = ~longitude,
                                  lat = ~latitude,
                                  radius = 10,
                                  stroke = F,
                                  fillOpacity = 0.9,
                                  color = 'blue')
        }

        if ( length(input$year)>1) {
            map = map %>% 
                addLayersControl(
                    overlayGroups = c('Data Markers 1', 'Data Markers 2'),
                    options = layersControlOptions(collapsed = FALSE) )
        } else {
            map = map %>% 
                addLayersControl(
                    overlayGroups = c('Data Markers 1'),
                    options = layersControlOptions(collapsed = FALSE) )
        }

    })
}

shinyApp(ui, server)

Answer 1

Суть в том, что вы должны использовать observeEvent() при работе с кнопками действий. Вы перепутали реактивный путь, поэтому значения изменились не в том порядке, в котором вы предполагали.

library(shiny)
library(leaflet)


hotels <- read.table(text = "Hotel Year  latitude        longitude
                     A   2000  41.886337      -87.628472
                     B   2005  41.88819       -87.635199
                     C   2010  41.891113      -87.63301", 
                     header = TRUE)


ui <- fluidPage(

  selectizeInput(inputId = 'year', label='Choose Year:',
                 choices = c(2000,2005,2010),
                 multiple=TRUE,
                 options = list(
                   maxItems = 2,
                   placeholder = '',
                   onInitialize = I("function() { this.setValue(''); }"))),
  actionButton("go", "go"),
  leafletOutput("mymap")

)

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

  # use the button for observeEvent
  # ignore values ensure an empty map is loading in the beginning
  observeEvent(input$go, ignoreInit = FALSE, ignoreNULL = FALSE, {

    # no need for a reactive list here
    if (length(input$year)>1) {
      df_list <- list(hotels[hotels$Year == input$year[1],], 
                     hotels[hotels$Year == input$year[2],])
    } else {
      df_list <- list(hotels[hotels$Year == input$year[1],])
    }

    output$mymap <- renderLeaflet({
      map <- leaflet()  %>%
        addProviderTiles("OpenStreetMap.Mapnik") %>% 
        addCircleMarkers( data = df_list[[1]] ,
                          group = 'Data Markers 1',
                          lng = ~longitude,
                          lat = ~latitude,
                          radius = 10,
                          stroke = F,
                          fillOpacity = 0.9,
                          color = 'red')
      # not using input does not invoke reactiveness
      if ( length(df_list) > 1){
        map <- map %>% 
          addCircleMarkers( data = df_list[[2]] ,
                            group = 'Data Markers 2',
                            lng = ~longitude,
                            lat = ~latitude,
                            radius = 10,
                            stroke = F,
                            fillOpacity = 0.9,
                            color = 'blue')
      }

      if ( length(input$year)>1) {
        map <- map %>% 
          addLayersControl(
            overlayGroups = c('Data Markers 1', 'Data Markers 2'),
            options = layersControlOptions(collapsed = FALSE) )
      } else {
        map <- map %>% 
          addLayersControl(
            overlayGroups = c('Data Markers 1'),
            options = layersControlOptions(collapsed = FALSE) )
      }

      map
    })
  })
}

shinyApp(ui, server)

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

Примечание: скорее используйте стрелки назначения для назначения;)