使用响应式制作的 Shiny 对象作为另一个响应式事件的输入

Question

我的闪亮应用使用DT 库呈现动态数据框。用户可以通过单击选择所需的行。选择行后，应用程序会显示并以数据框的形式下载转置的行。但是，这样做（显示和下载）我遇到如下错误-

错误 Warning: Error in [.data.frame: undefined columns selected [No stack trace available]

下面是详细步骤

1. 获取的数据（例如来自某个网​​站）
2. 用户通过单击选择行，然后单击actionButton() 将它们标记为“第一组”
3. 用户清除先前的选择并重复与“步骤 -2”相同的步骤以创建第二组。
4. clean() 函数将转置数据框（行名将成为列名），然后根据用户选择的row.names() 对数据框进行子集化。

添加了 cmets 的可重现代码

library(shiny)
library(DT)

temp_func <- function(){
  x <- mtcars
  y = x[,1]
  return(list(complete_df = as.data.frame(x), column1 = as.data.frame(y)))
}

clean <- function(df, g1, g2){
  x1 <- (mtcars)
  df_g1 <- subset(df, select = as.vector(g1))
  df_g2 <- subset(df, select = as.vector(g2))
  df_new <- cbind(df_g1, df_g2)
  return(as.data.frame(df_new))
}

# UI
ui <- shinyUI({
  fluidPage(
    actionButton("fetch", label = "Step1-Fetch data first"),
    DT::dataTableOutput("table"),br(),
    tags$h5("Selected for Group-1"), verbatimTextOutput("Group1"),br(),
    tags$h5("Selected for Group-2"),verbatimTextOutput("Group2"),hr(),br(),
    tags$h4("Follow Steps: "),
    actionButton("selG1", label = "Step-2: Mark as  Group-1"),
    actionButton("clear", label = "Step-3: Clear Selection"),
    actionButton("selG2", label = "Step-4: Mark as Group-2"),
    actionButton("cleanIt", "Step-5: Clean Dataframe"),
    DT::dataTableOutput("table2"),
    downloadButton("down", "Step-6: Download cleaned dataframe")
    )})

# Server
server <- Main_Server <- function(input,output,session){
  
  # Reactive Values
  values <- reactiveValues(table = NULL)
  group1 <- reactiveValues(Group1 = NULL)
  group2 <- reactiveValues(Group2 = NULL)
  clean_df <- reactiveValues(df = NULL)
  
  # fetchEvent (Consider temp_func() is fetching data from website)
  observeEvent(input$fetch, {values$table <- temp_func()})
  
  # Rendering table for display
  output$table <- renderDT({datatable(values$table$complete_df)})
  
  # Selection Event (Gorup1)
  observeEvent(input$selG1, {group1$Group1 <- rownames(values$table$complete_df[as.numeric(input$table_rows_selected),])})
  
  # Reset selections
  observeEvent(input$clear, {output$table <- renderDT({datatable(values$table$complete_df)})})
  
  # Selection Event (Gorup1)
  observeEvent(input$selG2, {group2$Group2 <- rownames(values$table$complete_df[as.numeric(input$table_rows_selected),])})
  
  # Print Events
  output$Group1 <- renderPrint({group1$Group1})
  output$Group2 <- renderPrint({group2$Group2})
  
  # observeEvent
  observeEvent(input$cleanIt, {clean_df$df <- clean(values$table$complete_df, group1$Group1, group2$Group2)
  })
  
  # Rendering table for display
  output$table2 <- renderDT({datatable(clean_df$df$df_new)})
  
   # Combined Download
  output$down <- downloadHandler(
    filename = function() { "File.csv"},
    content = function(file) {write.csv(clean_df$df$df_new, file)})
  
}

# Run-app
shinyApp(ui, server)

Answer 1

您的子集设置错误； g1 和 g2 是行名，但你在 subset 中使用了它，它需要列名（因此你得到了错误消息）。因此我更改了clean 函数。您的错误消息不是很丰富，因为您没有堆栈跟踪。如果你想获得堆栈跟踪，你应该使用 RStudio 中的 Shiny App 模板（参见 6.2.1 末尾的here）。有了这个，我得到了

Warnung: Error in [.data.frame: undefined columns selected
  78: stop
  77: [.data.frame
  75: subset.data.frame
  73: clean [C:\Users\jhage\Documents\Programmierung\Shiny_tests\app_2\shinytest7/app.R#12]
  72: observeEventHandler [C:\Users\jhage\Documents\Programmierung\Shiny_tests\app_2\shinytest7/app.R#63]
   1: runApp

因此更容易调试。

更正后的代码：

library(shiny)
library(DT)

temp_func <- function(){
  x <- mtcars
  y = x[,1]
  return(list(complete_df = as.data.frame(x), column1 = as.data.frame(y)))
}

clean <- function(df, g1, g2){
  df_selection <- df[c(which(rownames(df) == g1), which(rownames(df) == g2)),  ]
  df_new <- t(df_selection)
  return(as.data.frame(df_new))
}

# UI
ui <- shinyUI({
  fluidPage(
    actionButton("fetch", label = "Step1-Fetch data first"),
    DT::dataTableOutput("table"),br(),
    tags$h5("Selected for Group-1"), verbatimTextOutput("Group1"),br(),
    tags$h5("Selected for Group-2"),verbatimTextOutput("Group2"),hr(),br(),
    tags$h4("Follow Steps: "),
    actionButton("selG1", label = "Step-2: Mark as  Group-1"),
    actionButton("clear", label = "Step-3: Clear Selection"),
    actionButton("selG2", label = "Step-4: Mark as Group-2"),
    actionButton("cleanIt", "Step-5: Clean Dataframe"),
    DT::dataTableOutput("table2"),
    downloadButton("down", "Step-6: Download cleaned dataframe")
  )})

# Server
server <- Main_Server <- function(input,output,session){
  
  # Reactive Values
  values <- reactiveValues(table = NULL)
  group1 <- reactiveValues(Group1 = NULL)
  group2 <- reactiveValues(Group2 = NULL)
  clean_df <- reactiveValues(df = NULL)
  
  # fetchEvent (Consider temp_func() is fetching data from website)
  observeEvent(input$fetch, {values$table <- temp_func()})
  
  # Rendering table for display
  output$table <- renderDT({datatable(values$table$complete_df)})
  
  # Selection Event (Gorup1)
  observeEvent(input$selG1, {group1$Group1 <- rownames(values$table$complete_df[as.numeric(input$table_rows_selected),])})
  
  # Reset selections
  observeEvent(input$clear, {output$table <- renderDT({datatable(values$table$complete_df)})})
  
  # Selection Event (Gorup1)
  observeEvent(input$selG2, {group2$Group2 <- rownames(values$table$complete_df[as.numeric(input$table_rows_selected),])})
  
  # Print Events
  output$Group1 <- renderPrint({group1$Group1})
  output$Group2 <- renderPrint({group2$Group2})
  
  # observeEvent
  observeEvent(input$cleanIt, {clean_df$df <- clean(values$table$complete_df, group1$Group1, group2$Group2)
  })
  
  # Rendering table for display
  output$table2 <- renderDT({datatable(clean_df$df$df_new)})
  
  # Combined Download
  output$down <- downloadHandler(
    filename = function() { "File.csv"},
    content = function(file) {write.csv(clean_df$df$df_new, file)})
  
}

# Run-app
shinyApp(ui, server)

顺便说一句：看看datatable 的selection 参数，您可以将其设置为只能选择一行，然后您的应用中就不需要“撤消”按钮了。