Question

无法将两个不同的操作按钮链接到渲染表。任何时候＆＃34;保存队列＆＃34;用户启用操作按钮，正确保存数据集，输出表＆＃34; cohort_names＆＃34;更新就好了。但是，当我＆＃34;重置群组＆＃34;时，＆＃34;保存的群组＆＃34;名称表不为空。在下面的示例代码中，我引用了相同的假数据集。

shinyServer(function(input, output, session) {       
          populations = reactiveValues(a = 0)
          values = reactiveValues(extracted_data = NULL) 

          #This finds a dataframe to be saved
          observeEvent(input$run_query, {
            values$extracted_data = data.frame(id = c(153, 343, 996), sex = c(2,1,1)) #Just an example. Behind the scenes I am running an SQL query
          })

          #This action button saves a data frame to a reactive list
          observeEvent(input$save_cohort, {
            if(!is.null(values$extracted_data) & input$name_cohort != "a") {
              populations$a = populations$a + 1
              cname = ifelse(input$name_cohort == "", paste("Population", populations$a), input$name_cohort)
              populations[[cname]] = values$extracted_data #This object comes from a "run query" action and works just fine
              print(populations$a)
            }
          })

          #This action button is suppose to reset the reactive object "populations" to NULL and resets the counter (a)
          observeEvent(input$reset_cohorts, {
            populations = NULL
            populations$a = 0
            print(populations$a)
          })

          #Population info
          output$populations = renderText(populations$a)
          updated_names <- reactive({
              tmpnames = cbind(names(populations)[-which(names(populations) == "a")])
              colnames(tmpnames) = "Populations"
              print(tmpnames)
              tmpnames
          })

          #This is what is NOT updating. I need cohort_names to reset to nothing when reset_cohorts is enabled. It updates JUST FINE when save_cohorts is enabled. 
          output$cohort_names = renderTable({updated_names()}, align = 'c', width = "100%")
}

如果有人想要重新创建，这是一个简单的ui.r：

shinyUI(fluidPage(
  sidebarLayout(
    sidebarPanel(tableOutput("cohort_names")),
    mainPanel(actionButton("run_query", "Run Query"),
              actionButton("save_cohort", "Save Cohort"),
              actionButton("reset_cohorts", "Reset Cohorts"), 
              textInputRow("name_cohort",label= NULL, placeholder = "Enter Cohort Name"))
  )
)

我目前的运行理论是我正在正确地对待反应值，但我不能为我的生活找出一个合适的解决方案。任何建议将不胜感激

Answer 1

虽然我可以实现你想要的，但是我的代码有一个bug。如果您第一次按reset reset hhorts按钮，它会在后台重置所有内容（请参阅控制台打印），但UI不会显示更新的值。重置群组按钮上的第二次单击，一切都按预期工作。无法弄清楚为什么会发生这种情况:(

以下是代码，以防您遇到该错误。

library(shiny)
server <- function(input, output, session) {       
  populations <<- list()
  pop_counter <- reactiveValues(a = 0)
  values <- reactiveValues(extracted_data = NULL) 

  #This finds a dataframe to be saved
  observeEvent(input$run_query, {
    values$extracted_data = data.frame(id = c(153, 343, 996), sex = c(2,1,1)) #Just an example. Behind the scenes I am running an SQL query
  })

  #This action button saves a data frame to a reactive list
  observeEvent(input$save_cohort, {
    if(!is.null(values$extracted_data) & input$name_cohort != "a") {
      pop_counter$a = pop_counter$a + 1
      cname = ifelse(input$name_cohort == "", paste("Population", pop_counter$a), input$name_cohort)
      populations[[cname]] <<- values$extracted_data #This object comes from a "run query" action and works just fine
      print('inside saving cohort....')
      print(populations)
      print(class(populations))
      print(pop_counter$a)
    }
  })

  #This action button is suppose to reset the reactive object "populations" to NULL and resets the counter (a)
  observeEvent(input$reset_cohorts, {
    print('inside resetting of populations list')
    populations <<- list()
    pop_counter$a <- 0
    print(populations)
    print(pop_counter$a)
  })

  updated_names <- eventReactive(c(input$reset_cohorts, input$save_cohort),{
    print('inside updated_names() ...')
    if(length(populations) == 0) return(data.frame())

    tmpnames <- cbind(names(populations))#[-which(names(populations) == "a")]
    colnames(tmpnames) = "Populations"

    print(tmpnames)
    tmpnames
  })




  #This is what is NOT updating. I need cohort_names to reset to nothing when reset_cohorts is enabled. It updates JUST FINE when save_cohorts is enabled. 
  output$cohort_names = renderTable({updated_names()}, align = 'c', width = "100%")


  }


ui <-   shinyUI(fluidPage(
  sidebarLayout(
    sidebarPanel(tableOutput("cohort_names")),
    mainPanel(actionButton("run_query", "Run Query"),
              actionButton("save_cohort", "Save Cohort"),
              actionButton("reset_cohorts", "Reset Cohorts"), 
              textInput("name_cohort",label= NULL, placeholder = "Enter Cohort Name"))
  )
)
)

shinyApp(ui = ui, server = server)

使用闪亮操作按钮保存多个数据集并删除

1 个答案: