Как передать объект фрейма данных из renderUI в eventReactive?

Question

Надеюсь, мне ясно. Я хочу знать, как передать пользовательский фрейм данных из renderUI в evenReactive в функции сервера. Проблема в том, что в eventReactive ct не найден. Пожалуйста, сообщите!

Мой код выглядит следующим образом:

ui <-
  fluidPage(
    sidebarPanel(
      fileInput("file1", "Import",
                accept = c(".xlsx")),
      uiOutput("selectCAT"),
      actionButton("goBu", "Click!")),

    mainPanel("Display Results"
              tableOutput("acBTTON")
    ))



server <- function(input, output, session)
{
  output$selectCAT <- renderUI({
    req(input$file1)
    ct <- read_excel(input$file1$datapath, sheet = "abc")
    empl <- read_excel(input$file2$datapath, sheet = "emp")

    selectInput(inputId = "showp",
                label = "Selection",
                empl)})
}


 pf <- eventReactive(input$goBu,{
    s1 <- sqldf("SELECT * FROM ct")
  })
  output$acBTTON <- renderTable({
    pf()})

Answer 1

Несколько слов об этом подробном / расширенном образце приложения.

• Не думаю, что вам действительно нужны uiOutput и renderUI, поскольку вы пытаетесь изменить доступноепараметры в selectInput.
• Я включил некоторые подробности, чтобы вы могли (например) увидеть req работающий, легко отключаемый или удаляемый (у меня часто этот код есть в моих собственных блестящих приложениях, отключенных по умолчанию), когда мне нужно устранить неполадки, которые могут включать реактивность).(Если вы видите In: и не соответствует Out:, это означает, что поток строки req прерван из-за недостаточных требований.)
• В вашем примере вы указали file2, но никогда не настраивали его ..Я проигнорировал это, но я думаю, что вы могли бы расширить ui, чтобы приспособить его, и server логику, чтобы справиться с этим.
• Использование sqldf, как правило, достаточно безопасно, но SQL предлагаетне защищает (напрямую) от внедрения SQL.Если вы выполняете эти запросы с произвольным текстом, заданным пользователем, следует принять дополнительные меры предосторожности.
• Я добавил defcat, сообщение типа «выберите категорию» в выпадающем меню.Поскольку это явно не то, что вы хотите фильтровать, я явно гарантирую, что это не выбранная категория перед фильтрацией (и, следовательно, рендерингом).

Учитывая это, я представлю два результата: один без renderUI и один с ним.

---

Первый, без:

library(shiny)
library(sqldf)

defcat <- "Select a category ..."
ui <- fluidPage(
  sidebarPanel(
    fileInput("file1", "Import", accept = ".xlsx"),
    selectInput("selectCAT", "Category", choices = defcat),
    actionButton("goBu", "Click!")
  ),
  mainPanel(
    "Display Results",
    tableOutput("acBTTON")
  )
)

verbose <- TRUE
msg <- if (verbose) message else c

server <- function(input, output, session) {
  dat_mt <- eventReactive(input$file1, {
    msg("In: dat_mt ...")
    req(input$file1)
    out <- readxl::read_excel(input$file1$datapath, "mt")
    msg("Out: dat_mt ...")
    out
  })
  dat_ir <- eventReactive(input$file1, {
    msg("In: dat_ir ...")
    req(input$file1)
    out <- readxl::read_excel(input$file1$datapath, "ir")
    msg("Out: dat_ir ...")
    out
  })

  observeEvent(dat_mt(), {
    msg("In: observe dat_mt() ...")
    req(dat_mt())
    sel <- if (input$selectCAT %in% dat_mt()$cyl) input$selectCAT else defcat
    updateSelectInput(session, "selectCAT",
                      choices = c(defcat, sort(unique(dat_mt()$cyl))),
                      selected = sel)
    msg("Out: observe dat_mt() ...")
  })

  pf <- eventReactive(input$goBu, {
    msg("In: event input$goBu ...")
    req(defcat != input$selectCAT, dat_mt(), dat_ir())
    mt <- dat_mt()
    ir <- dat_ir()
    # WARNING: potential for SQL injection, proof-of-concept only
    out <- sqldf(paste("select * from mt where cyl =", input$selectCAT))
    msg("Out: event input$goBu ...")
    out
  })

  output$acBTTON <- renderTable({
    msg("In: acBTTN ...")
    req(pf())
    out <- pf()
    msg("Out: acBTTN ...")
    out
  })
}
shinyApp(ui, server)

---

Второй, с динамическим интерфейсом.Отмечены только два различия:

ui <- fluidPage(
  sidebarPanel(
    fileInput("file1", "Import", accept = ".xlsx"),
    ## replace selectInput with this:
    uiOutput("selectCATdyn"),
    ## end dif
    actionButton("goBu", "Click!")
  ),
  mainPanel(
    "Display Results",
    tableOutput("acBTTON")
  )
)

server <- function(input, output, session) {
  dat_mt <- eventReactive(input$file1, {
    msg("In: dat_mt ...")
    req(input$file1)
    out <- readxl::read_excel(input$file1$datapath, "mt")
    msg("Out: dat_mt ...")
    out
  })
  dat_ir <- eventReactive(input$file1, {
    msg("In: dat_ir ...")
    req(input$file1)
    out <- readxl::read_excel(input$file1$datapath, "ir")
    msg("Out: dat_ir ...")
    out
  })

  ## replace observeEvent(dat_mt(),... with      
  output$selectCATdyn <- renderUI({
    req(dat_mt(), dat_ir())
    selectInput(inputId = "selectCAT", label = "Selection",
                choices = c(defcat, sort(unique(dat_mt()$cyl))),
                selected = defcat)
  })
  ## end diff

  pf <- eventReactive(input$goBu, {
    msg("In: event input$goBu ...")
    on.exit( msg("Out: event input$goBu ...") )
    req(defcat != input$selectCAT, dat_mt(), dat_ir())
    mt <- dat_mt()
    ir <- dat_ir()
    # WARNING: potential for SQL injection, proof-of-concept only
    out <- sqldf(paste("select * from mt where cyl =", input$selectCAT))
    out
  })

  output$acBTTON <- renderTable({
    msg("In: acBTTN ...")
    req(pf())
    out <- pf()
    msg("Out: acBTTN ...")
    out
  })
}

Когда я играю с этим, я понимаю, почему вы хотели динамический интерфейс, так что теперь это "имеет больше смысла": -)

Примечание:хотя: вы можете получить аналогичный эффект, определив его статически (как в моем первом решении) и использовать shinyjs::hide или shinyjs::disable внутри другого блока observe.

---

Настройка:

wb <- openxlsx::createWorkbook()
openxlsx::addWorksheet(wb, "mt")
openxlsx::writeDataTable(wb, "mt", x = mtcars)
openxlsx::addWorksheet(wb, "ir")
openxlsx::writeDataTable(wb, "ir", x = iris)
openxlsx::saveWorkbook(wb, "Johnseito.xlsx")