在eventReactive()中使用被动()数据框?

时间:2018-04-13 01:31:05

标签: r shiny

我希望有人可以就解决我遇到的问题提供一些指导。对于背景,我正在尝试为用户创建一个界面来上传新闻故事的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)

2 个答案:

答案 0 :(得分:0)

我认为您应该进行一些更改以使您的reactive和输出有效。

  • 删除return表达式中的reactive,因为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)
  })

}

答案 1 :(得分:0)

我设法通过将数据存储在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)