How to pass data frame object from renderUI to eventReactive?

问题

I hope I am clear. I want to know how to pass user input data frame from renderUI to evenReactive in the server function. The problem is that in the eventReactive, ct is not found. Please advise !

My code is as follow:

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()})

回答1:

A few things about this verbose/augmented sample app.

I don't think you really need uiOutput and renderUI, since what you are trying to do is change the available options in a selectInput.
I included some verbosity, so you can (for example) see req working, easily disabled or removed (I often have this code in my own shiny apps, disabled by default, for when I need to troubleshoot anything that might involve reactivity). (If you see In: and no corresponding Out:, this means the req line interrupted flow due to insufficient requirements.)
You referenced file2 in your example but never set it up ... I ignored it, but I think you could extend your ui to accommodate it, and server logic to handle it.
The use of sqldf is generally safe enough, but the SQL it suggests does not guard (directly) against SQL injection. If you take these queries with user-defined free text, more safeguards should be taken.
I added defcat, a "select a category" type message in the pull-down. Because it's obviously not something you want to filter on, I explicitly ensure it is not the selected category before filtering (and therefore rendering).

Given that, I'll present two results: one without renderUI, and one with it.

The first, without:

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)

The second, with dynamic UI. The only two differences are noted:

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
  })
}

As I play with this, I realize why you wanted dynamic UI, so it now "makes more sense" :-)

Side note, though: you can have a similar effect by defining it statically (as in my first solution) and use shinyjs::hide or shinyjs::disable inside another observe block.

Setup:

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")

来源：https://stackoverflow.com/questions/53027209/how-to-pass-data-frame-object-from-renderui-to-eventreactive

标签

dataframe

Shiny