Как передать выбранный пользователем заголовок столбца, чтобы эти переменные могли отображаться во всплывающем окне

Question

Я бы хотел, чтобы пользователь мог выбрать, какую переменную он видит во всплывающем окне на карте листовок. Это работает, когда переменные жестко закодированы. Однако что-то не так с передачей заголовка столбца. Ниже приведен воспроизводимый пример, который вы заметите, когда выберете две переменные, которые будут отображаться на карте, но без каких-либо данных во всплывающих окнах.

library(shiny)
library(sf)
library(leaflet)

ui <- fluidPage(
   titlePanel("test"),

      mainPanel(
         leafletOutput("map"),
         selectInput("var1", label = h5("Select Independent"), "", multiple = TRUE),
         selectInput("var2", label = h5("Select Dependent"), "", multiple = TRUE)             
      )
   )

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

  nc <- reactive({
    st_read(system.file("shape/nc.shp", package="sf"))
  })

  observe({
    updateSelectInput(
      session,
      "var1",
      choices=names(nc()))
  })

  observe({
    updateSelectInput(
      session,
      "var2",
      choices=names(nc()))      
  })

  output$map <- renderLeaflet({
    req(input$var1)
    req(input$var2)
    x <- as.character(input$var1)
    y <- as.character(input$var2)
    leaflet(nc()) %>% addTiles %>% addPolygons(
      popup = paste0("Var1: ", as.character(nc()$x),"<br>",
                    "Var2: ", as.character(nc()$y),"<br>")
    )
  })

}
shinyApp(ui = ui, server = server)

Answer 1

Вам нужно использовать двойной индекс вместо знака доллара для передачи строки имени столбца, например.

library(shiny)
library(sf)
library(leaflet)

ui <- fluidPage(
  titlePanel("test"),

  mainPanel(
    leafletOutput("map"),
    selectInput("var1", label = h5("Select Independent"), "", multiple = TRUE),
    selectInput("var2", label = h5("Select Dependent"), "", multiple = TRUE)             
  )
)

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

  nc <- reactive({
    st_read(system.file("shape/nc.shp", package="sf"))
  })

  observe({
    updateSelectInput(
      session,
      "var1",
      choices=names(nc()))
  })

  observe({
    updateSelectInput(
      session,
      "var2",
      choices=names(nc()))      
  })

  output$map <- renderLeaflet({
    req(input$var1)
    req(input$var2)
    x <- as.character(input$var1)
    y <- as.character(input$var2)
    leaflet(nc()) %>% addTiles %>% addPolygons(
      popup = paste0("Var1: ", as.character(nc()[[x]]),"<br>",
                     "Var2: ", as.character(nc()[[y]]),"<br>")
    )
  })

}
shinyApp(ui = ui, server = server)