在 eventReactive() 中使用 reactive() 数据框？

Question

我希望有人可以就解决我遇到的问题提供一些指导。作为背景，我正在尝试为用户创建一个界面来上传新闻报道的 csv，然后他们可以将其注释为相关或不相关，以用于分类。用户上传 csv 后应该出现的是带有可选行的表格输出。与所选行关联的文本将显示在右下方。

我尝试的设置是将用户上传的电子表格放入一个 reactive()，然后将其作为 eventReactive() 的一部分用于注释句子是否相关。但是，当我运行应用程序时，该表没有出现，并且没有错误或警告消息。我尝试修改我的方法以在加载 csv 时使用 reactiveValues() 和 observe()，但我遇到了同样的问题。我已经包含了下面的代码，以及一个玩具数据集。

过去几个小时我一直在网上搜索解决方案，但运气不佳。任何指导将不胜感激！

数据

sample <- data.frame(relevant = c('','','','',''), lede=c('first lede', 'second lede', 'third lede', 'fourth lede', 'fifth lede'))
write.csv(sample, 'sample.csv', row.names=F)

应用代码

library(shiny) 
library(DT)


#######################################################
### INTERFACE
#######################################################

in1 <-   radioButtons("truefalse", "Change values in 'keep' column here", 
                      choices=c("TRUE", "FALSE"),
                      selected = "TRUE", inline = FALSE)
in2 <-   actionButton("goButton", "Update Table")
in3 <-   downloadButton("download_data", label = "Download")
in4 <- fileInput('datafile', 'Choose CSV file',
                 accept=c('text/csv', 'text/comma-separated-values,text/plain'))

out1 <- textOutput("text")
out2 <- dataTableOutput("sheet", width = "30%")

in5 <- textInput("save_file", "New file name:", value="updated_data.csv")
in6 <- actionButton("save", "Save updated data")

ui <- fluidPage(titlePanel("Text Annotater"),
                column(6, out2),
                column(6, in4, in1, in2, in5, in6, out1))


#######################################################
### SERVER 
#######################################################
server <- function(input, output){

  sheet <- reactive({
    infile <- input$datafile
    if (is.null(infile)) {
      # User has not uploaded a file yet
      return(NULL)
    }
    tbl = read.csv(infile$datapath, stringsAsFactors = FALSE)
    return(tbl)
  })



  # reactive dataframe object
  df <- eventReactive(input$goButton, {
    if(selected_row_id()>0 &&input$goButton>0){  
      sheet()[selected_row_id(),1] <<- input$truefalse
    }
    sheet()
  }, ignoreNULL = FALSE)

  # selectable data table 
  output$sheet <- renderDataTable({
    df()
  }, selection = "single")

  # selected row ID from data table
  selected_row_id <- reactive({
    input$sheet_rows_selected
  })

  # text of article
  output$text<-renderText({sheet()[input$sheet_rows_selected, "lede"]})

  # Save when click the button
  observeEvent(input$save, {
    write.csv(df, input$save_file, row.names = FALSE)
  })

  # download button
  output$download_data <- downloadHandler(
    filename = "updated_data.csv",
    content = function(file) {
      write.csv(df(), file, row.names = FALSE)
    }
  )

}

shinyApp(ui = ui, server = server)

Answer 1

我认为您应该进行一些更改以使您的 reactive 和输出正常工作。

• 删除reactive 表达式中的return，因为reactive 只捕获表达式的最后一个输出。
• 将所有reactive 移到任何函数之外，因为您始终可以检查input$goButton（在您的情况下）是否在反应函数内部触发。
• 使用ObserveEvent 来触发事件（如input$goButton）而不是eventReactive，因为eventReactive 只给出一个值（而不是渲染输出并将它们保留在范围内）。
• 将reactiveValues 用于更改ObserveEvent 中值的任何变量（df_sheet）
• 将df 更改为df_sheet

这里是修改后的server函数：

server <- function(input, output){
  v <- reactiveValues(df_sheet = NULL)

  sheet <- reactive({
    infile <- input$datafile
    if (is.null(infile)) {
      # User has not uploaded a file yet
      NULL
    } else {
      tbl = read.csv(infile$datapath, stringsAsFactors = FALSE)

      if(!is.null(selected_row_id())) {
        if (selected_row_id() > 0){  
          tbl[selected_row_id(),1] <- input$truefalse
        }
      } 

      tbl
    }
  })


  # selected row ID from data table
  selected_row_id <- reactive({
    input$sheet_rows_selected
  })


  # reactive dataframe object
  observeEvent(input$goButton, {

    v$df_sheet <- sheet()

    # selectable data table 
    output$sheet <- renderDataTable({
      v$df_sheet
    }, selection = "single")

  }, ignoreNULL = FALSE)


  # Save when click the button
  observeEvent(input$save, {

    # text of article
    output$text<-renderText({v$df_sheet[input$sheet_rows_selected, "lede"]})

    # download button
    output$download_data <- downloadHandler(
      filename = "updated_data.csv",
      content = function(file) {
        write.csv(v$df_sheet, file, row.names = FALSE)
      }
    )

    write.csv(v$df_sheet, input$save_file, row.names = FALSE)
  })

}

Answer 2

我设法通过将数据存储在reactiveValues 中，将eventReactive() 替换为observeEvent，然后使用isolate() 更新数据来完成这项工作。

工作服务器代码

server <- function(input, output){
  v = reactiveValues(df_sheet = NULL)
  sheet <- reactive({
    infile <- input$datafile
    if (is.null(infile)) {
      # User has not uploaded a file yet
      return(NULL)
    }
    tbl = read.csv(infile$datapath, stringsAsFactors = FALSE)
    v$df_sheet = tbl
    tbl
  })



  # reactive dataframe object
   observeEvent(input$goButton, {
     isolate({
       if(!is.null(selected_row_id())) {
         if (selected_row_id() > 0){  
           v$df_sheet[selected_row_id(),1] <- input$truefalse
         }
       } 
    })
  }, ignoreNULL = FALSE)

  # selectable data table 
  output$sheet <- renderDataTable({
    v$df_sheet[,c(1,2)]
  }, selection = "single")

  # selected row ID from data table
  selected_row_id <- reactive({
    input$sheet_rows_selected
  })

  # text of article
  output$text<-renderText({sheet()[input$sheet_rows_selected, "lede"]})

  # Save when click the button
  observeEvent(input$save, {
    write.csv(v$df_sheet, paste('data/',input$save_file, sep=''), row.names = FALSE)
  })

  # download button
  output$download_data <- downloadHandler(
    filename = "updated_data.csv",
    content = function(file) {
      write.csv(v$df_sheet, paste('data/', file, sep=''), row.names = FALSE)
    }
  )

}

shinyApp(ui = ui, server = server)