How to add comment to a reactive data table in shiny

Question

This question is an extension of the question I posted: this question

I created a dataframe with 3 columns: num, id and val. I want my shiny app to do the following:

a dataframe dat is filtered by num column
select an value from id column from dat (selectInput).
add text comment in a text box (textInput)
click on an action button
A new column called comment is created in the data table, text comments are added to the comment column in the row where id equals the value selected.

The code is below. I cannot figure out why it's not working.

Thank a lot in advance!

    library(shiny)
    library(DT)
    dat = data.frame(num=rep(1:2, each=5), id=rep(LETTERS[1:5],2), val=rnorm(10)) 
    ui = fluidPage(
        fluidRow(
            column(12, selectInput('selectNum', label='Select Num', 
                                 choices=1:10, selected='')),
            column(2, selectInput(inputId = 'selectID',
                                  label = 'Select ID2',
                                  choices = LETTERS[1:10],
                                  selected='',
                                  multiple=TRUE)),
            column(6, textInput(inputId = 'comment', 
                                label ='Please add comment in the text box:', 
                                value = "", width = NULL,
                                placeholder = NULL)),
            column(2, actionButton(inputId = "button", 
                                   label = "Add Comment"))
        ),
        fluidRow (
            column(12, DT::dataTableOutput('data') ) 
        )           
    )

    server <- function(input, output, session) {

     ## make df reactive

     df = reactive ({ dat %>% filter(num %in% input$selectNum) })
     df_current <- reactiveVal(df())

     observeEvent(input$button, {

      req(df_current())

      ## update df by adding comments
      df_new <- df_current()
      df_new[df_current()$id %in% input$selectID, "Comment"] <- input$comment

      df_current(df_new)

      })

      output$data <- DT::renderDataTable({

      req(df_current())

      DT::datatable(df_current(), 
          options = list(orderClasses = TRUE,
              lengthMenu = c(5, 10, 20), pageLength = 5))
     })

    shinyApp(ui=ui, server=server)

Joris C. · Accepted Answer · 2019-06-10T12:19:59.977

Instead of using a reactive/eventReactive statement for df, it might be more natural to keep track of previously inputted comments in the Comment column using a reactiveVal object for df. See also the responses to this question: R Shiny: reactiveValues vs reactive. If you prefer to use a reactive/eventReactive statement for df it is probably better to work with a separate object to store previous input comments (instead of incorporating it into the reactive statement for df).

library(shiny)
library(DT)
dat = data.frame(num=1:10, id=LETTERS[1:10], val=rnorm(10)) 
ui = fluidPage(
    fluidRow(
        column(12, selectInput('selectNum', label='Select Num', 
                choices=1:10)),
        column(2, selectInput(inputId = 'selectID',
                label = 'Select ID2',
                choices = LETTERS[1:10],
                selected='',
                multiple=TRUE)),
        column(6, textInput(inputId = 'comment', 
                label ='Please add comment in the text box:', 
                value = "", width = NULL,
                placeholder = NULL)),
        column(2, actionButton(inputId = "button", 
                label = "Add Comment"))
    ),
    fluidRow (
        column(12, DT::dataTableOutput('data') ) 
    )            
)

server <- function(input, output, session) {

  ## make df reactive
  df_current <- reactiveVal(dat)

  observeEvent(input$button, {

        req(df_current(), input$selectID %in% dat$id)

        ## update df by adding comments
        df_new <- df_current()
        df_new[df_current()$id %in% input$selectID, "Comment"] <- input$comment

        df_current(df_new)

      })

  output$data <- DT::renderDataTable({

        req(df_current())

        ## filter df_current by 'selectNum'
        df_filtered <- df_current()[df_current()$num %in% input$selectNum, ]

        ## show comments if non-empty
        showComments <- is.null(df_filtered$Comment) || !all(is.na(df_filtered$Comment))

        DT::datatable(df_filtered, 
            options = list(orderClasses = TRUE,
                lengthMenu = c(5, 10, 20), pageLength = 5,
                columnDefs = list(
                    list(targets = ncol(df_filtered), visible = showComments)
                )
            )
        )

      })
}

shinyApp(ui=ui, server=server)

Edit: below an edited server function that using df_current <- reactive({...}) instead of df_current <- reactiveVal({...}) and defining a separate reactiveVal object to keep track of the comments.

server <- function(input, output, session) {

  ## initialize separate reactive object for comments
  df_comments <- reactiveVal({
        data.frame(
            id = character(0), 
            Comment = character(0),
            stringsAsFactors = FALSE
        )
      })

  ## reactive object df
  df_current <- reactive({

        ## reactivity that df depends on
        ## currently df = dat does not change
        df <- dat

        ## merge with current comments
        if(nrow(df_comments()) > 0)
        df <- merge(df, df_comments(), by = "id", all.x = TRUE)

        return(df)

      })

  observeEvent(input$button, {

        req(input$selectID)

        ## update df_comments by adding comments
        df_comments_new <- rbind(df_comments(), 
            data.frame(id = input$selectID, Comment = input$comment)
        )

        ## if duplicated id's keep only most recent rows 
        df_comments_new <- df_comments_new[!duplicated(df_comments_new$id, fromLast = TRUE), , drop = FALSE]

        df_comments(df_comments_new)

      })

  output$data <- DT::renderDataTable({

        req(df_current())

        ## filter df_current by 'selectNum'
        df_filtered <- df_current()[df_current()$num %in% input$selectNum, ]

        ## show comments if non-empty
        showComments <- is.null(df_filtered$Comment) || !all(is.na(df_filtered$Comment))

        DT::datatable(df_filtered, 
            options = list(orderClasses = TRUE,
                lengthMenu = c(5, 10, 20), pageLength = 5,
                columnDefs = list(
                    list(targets = ncol(df_filtered), visible = showComments)
                )
            )
        )

      })
}

Thanks a lot! Your code works for this example. In my work, the very original data in shiny is 'reactive' since I'm importing variable number of files depending on user's need. So is any way to use `df()` for this add comment function? `df()` is actually used in a couple of other tabs in my app. We cannot do `reactiveVal(df()) ......`? @Joris Chau — zesla, Jun 10 '19 at 11:33
I edited the response using a reactive expression with `df_current <- reactive({...})` that gets updated when new comments are added in the object `df_comments` — Joris C., Jun 10 '19 at 12:23

Junior Hechinger · Answer 2 · 2019-06-09T15:43:01.857

There you have got a working example.

I think the thing is that you are trying to update a value through an observeEvent which is not good according to the documentation. ?observeEvent

Use observeEvent whenever you want to perform an action in response to an event. (Note that "recalculate a value" does not generally count as performing an action–see eventReactive for that.)

library(shiny)
library(DT)
dat = data.frame(num=1:10, id=LETTERS[1:10], val=rnorm(10)) 
ui = fluidPage(
  fluidRow(
    column(12, selectInput('selectNum', label='Select Num', 
                           choices=1:10, selected='')),
    column(2, selectInput(inputId = 'selectID',
                          label = 'Select ID2',
                          choices = LETTERS[1:10],
                          selected='',
                          multiple=TRUE)),
    column(6, textInput(inputId = 'comment', 
                        label ='Please add comment in the text box:', 
                        value = "", width = NULL,
                        placeholder = NULL)),
    column(2, actionButton(inputId = "button", 
                           label = "Add Comment"))
  ),
  fluidRow (
    column(12, DT::dataTableOutput('data') ) 
  )           
)

server <- function(input, output, session) {

  ## make df reactive

  df_current = reactive({ 
    df = dat %>% filter(num %in% input$selectNum) 

    if(input$button != 0) {
      input$button    
      df[df$id %in% input$selectID, "Comment"] <- isolate(input$comment)
    }

    return(df)
    })


  output$data <- DT::renderDataTable({

    req(df_current())
    DT::datatable(df_current(), 
                  options = list(orderClasses = TRUE,
                                 lengthMenu = c(5, 10, 20), pageLength = 5))
  })
}
  shinyApp(ui=ui, server=server)

So you can either go with your reactive value or using eventReactive as stated in the doc.

How to add comment to a reactive data table in shiny

2 Answers2

Linked