shiny: how to catch manual input of an interactive table and export it?

Question

I created an interactive table that takes changes both from selectizeInput and manual input. I need to write the table to a database after updating. My problem is that I can catch the changes made by selectizeInput. I don't know how to catch and save the changes made by manual input. For example,

library(shiny)
library(shinydashboard)
library(DT)
library(DBI)

ui <- dashboardPage(
  dashboardHeader(title = "test"),
  dashboardSidebar(),
dashboardBody(shiny::selectizeInput(inputId = "apple_lbs_filter",
                                    label = "Apple lbs",
                                    choices = c(1:10)),
              shiny::selectizeInput(inputId = "cherry_lbs_filter",
                                    label = "Cherry lbs",
                                    choices = c(1:10)),
              shiny::selectizeInput(inputId = "pineapple_lbs_filter",
                                    label = "Pineapple lbs",
                                    choices = c(1:10)),
              shiny::selectizeInput(inputId = "pear_lbs_filter",
                                    label = "Pear lbs",
                                    choices = c(1:10)),
              shiny::actionButton(inputId = "update_lbs",label = "Update lbs"),
              DT::DTOutput("fruit"))
)

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

  fruit_df <- shiny::reactiveValues()
  fruit_df$df <- data.frame(fruit_name = c("apple","cherry","pineapple","pear"),
                            fruit_lbs = c(2,5,6,3))  
  
  output$fruit <- DT::renderDT({
      DT::datatable(fruit_df$df,editable = TRUE,extensions = 'Buttons',options = list(
        dom = 'frtBip',
        buttons = c('csv')
      ))
    })
  
  lbs_newentry <- shiny::observe({
    if(input$update_lbs > 0) {
      lbs_newline <- shiny::isolate(c(
        input$apple_lbs_filter,
        input$cherry_lbs_filter,
        input$pineapple_lbs_filter,
        input$pear_lbs_filter
      ))
      shiny::isolate(fruit_df$df <- cbind(fruit_name = c("apple",
                                               "cherry",
                                               "pineapple",
                                               "pear"),
                                       fruit_lbs = lbs_newline))
      
      # conn <- DBI::dbConnect(drv, user, password)
      # DBI::dbWriteTable(conn = conn,
      #                   SQL(schema.tbl),
      #                   fruit_df$df)
      # DBI::dbDisconnect(conn)
    }
  })
}

shinyApp(ui, server)

Using the code above I can write a table to database with updates made by selectizeInput,but not by manual. I commented writing to database part so that you won't run into errors when you test it. My guess is that the data I wrote to db is fruit_df$df, which does NOT catch or save manual input. What should I do to catch and save both selectizeInput and manual input and be able to export all the changes to a db? Thanks!

Answer 1

You must avoid using a reactive dataframe in datatable, because when it changes then the full table is regenerated, and this can be avoided with a proxy:

library(shiny)
library(shinydashboard)
library(DT)

ui <- dashboardPage(
  dashboardHeader(title = "test"),
  dashboardSidebar(),
  dashboardBody(
    fluidRow(
      column(
        width = 6,
        selectizeInput(inputId = "apple_lbs_filter",
                       label = "Apple lbs",
                       choices = c(1:10)),
        selectizeInput(inputId = "cherry_lbs_filter",
                       label = "Cherry lbs",
                       choices = c(1:10)),
        selectizeInput(inputId = "pineapple_lbs_filter",
                       label = "Pineapple lbs",
                       choices = c(1:10)),
        selectizeInput(inputId = "pear_lbs_filter",
                       label = "Pear lbs",
                       choices = c(1:10))
      ),
      column(
        width = 6,
        verbatimTextOutput("reactiveDF")
      )
    ),
    actionButton("update_lbs", label = "Update lbs", class = "btn-primary"),
    br(), br(),
    DTOutput("fruit")
  )
)

server <- function(input, output, session) {
  
  Fruits <- reactiveVal(
    data.frame(
      fruit_name = c("apple", "cherry", "pineapple", "pear"),
      fruit_lbs = c(2, 5, 6, 3)
    ) 
  )
  
  output[["fruit"]] <- renderDT({
    datatable(
      isolate(Fruits()), # isolate to avoid regenerating the table (see proxy below)
      editable = list(target = "cell", disable = list(columns = c(0, 1))),
      extensions = 'Buttons',
      options = list(
        dom = 'frtBip',
        buttons = c('csv')
      )
    )
  })
  
  # use a proxy to update the data without regenerating the full table
  proxy <- dataTableProxy("fruit")
  
  observeEvent(input[["update_lbs"]], {
    lbs_newline <- c(
      input[["apple_lbs_filter"]],
      input[["cherry_lbs_filter"]],
      input[["pineapple_lbs_filter"]],
      input[["pear_lbs_filter"]]
    )
    dat <- Fruits()
    dat[["fruit_lbs"]] <- lbs_newline
    Fruits(dat) # update the reactive dataframe
    replaceData(proxy, dat, resetPaging = FALSE)
  })
  
  observeEvent(input[["fruit_cell_edit"]], { 
    info <- input[["fruit_cell_edit"]] # this input contains the info of the edit
    Fruits(editData(Fruits(), info, proxy)) 
    # editData() updates the data of the table
    # and returns the new dataframe that we store in the reactive dataframe
  })
  
  output[["reactiveDF"]] <- renderPrint({ # just to check
    Fruits()
  })
}

shinyApp(ui, server)

Here the reactivity of the dataframe Fruits() is not necessary. You can proceed as follows instead:

server <- function(input, output, session) {
  
  Fruits <- data.frame(
    fruit_name = c("apple", "cherry", "pineapple", "pear"),
    fruit_lbs = c(2, 5, 6, 3)
  ) 
  
  output[["fruit"]] <- renderDT({
    datatable(
      Fruits, 
      editable = list(target = "cell", disable = list(columns = c(0, 1))),
      extensions = 'Buttons',
      options = list(
        dom = 'frtBip',
        buttons = c('csv')
      )
    )
  })
  
  # use a proxy to update the data without regenerating the full table
  proxy <- dataTableProxy("fruit")
  
  observeEvent(input[["update_lbs"]], {
    lbs_newline <- c(
      input[["apple_lbs_filter"]],
      input[["cherry_lbs_filter"]],
      input[["pineapple_lbs_filter"]],
      input[["pear_lbs_filter"]]
    )
    dat <- Fruits
    dat[["fruit_lbs"]] <- lbs_newline
    Fruits <<- dat
    replaceData(proxy, Fruits, resetPaging = FALSE)
  })
  
  observeEvent(input[["fruit_cell_edit"]], { 
    info <- input[["fruit_cell_edit"]] # this input contains the info of the edit
    Fruits <<- editData(Fruits, info, proxy) 
  })
  
}

But with this way you can't do the verbatimTextOutput as before.