保存多個數據集並使用閃亮的動作按鈕刪除

Question

無法將兩個不同的動作按鈕鏈接到呈現的表格。只要用戶啓用了「保存隊列」操作按鈕，數據集就會被正確保存，並且輸出表「cohort_names」更新得很好。但是，當我「重新設置隊列」時，「已保存的隊列」名稱表不會清空。在下面的示例代碼中，我引用了相同的假數據集。

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

我當前正在運行的理論是，我是不正確的治療reactiveValues，但我不能爲我的生活出適當的解決方案。任何意見將不勝感激

Answer 1

雖然我可以實現你想要的，我的代碼有一個錯誤。如果您第一次按下「重置羣組」按鈕，它將在後臺重置所有內容（請參閱控制檯打印），但UI不會顯示更新的值。第二次點擊復位隊列按鈕，一切按預期工作。無法弄清楚爲什麼發生這種情況，雖然:(

下面是萬一代碼，你可以用這個bug生活。

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)