Working with a reactive() dataframe inside eventReactive()?

问题

I was hoping someone could provide some guidance on resolving an issue I have. For background, I'm trying to create an interface for users to upload a csv of news stories, which they can then annotate as relevant or not relevant for the purposes of a classifier. What should appear once the user has uploaded a csv is a table output with selectable rows. The text associated with the selected row would then display in the lower right.

The setup I have attempted is to put the user-uploaded spreadsheet into a reactive(), which is then worked with as part of an eventReactive() to annotate sentences as relevant or not. However, the table does not appear when I run the app, and there are no error or warning messages. I've tried modifying my approach to use reactiveValues() and observe() when loading the csv, but I encounter the same issue. I've included the code below, as well as a toy dataset.

I've spent the past couple of hours scouring the web for solutions, but haven't had much luck. Any guidance would be appreciated!

Data

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)

Code for app

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)

回答1:

I think you should made several changes to make your reactive and the output works.

remove the return in the expression of reactive because reactive only captures the last output from the expression.
Move all the reactive outside of any function because you can always check if the input$goButton (in your case) is triggered inside reactive function.
Use ObserveEvent for the triggering of events (like input$goButton) instead of eventReactive because eventReactive only gives out a value (rather than renders for outputs and keeps them in the scope).
Use reactiveValues for any variable (df_sheet) that changes values in ObserveEvent
Change df to df_sheet

Here is the modified server function:

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

}

回答2:

I managed to get this working by storing the data in a reactiveValues, replacing eventReactive() with observeEvent, then updating the data using isolate().

Working server code

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)

来源：https://stackoverflow.com/questions/49808023/working-with-a-reactive-dataframe-inside-eventreactive

标签

Shiny