Update reactiveValues in Shiny R

Question

I understand similar questions have been asked and I've tried virtually every solution with no luck.

In my application, I've allowed the user to modify individual cells of a DT::datatable. The source of the datatable is a reactive data frame. After the user makes changes to the clientside datatable, the datatable source is remains unchanged. This is an issue as later on, when I allow the user to add rows to the data table, the row is added onto the source datatable where the clientside datatable then reflects this change. However, this means that if the user makes a change to a cell in the clientside datatable, when the user adds a row to the same table, the change made by the user will be forgotten as it was never made to the source.

I've tried many ways to update the underlying/serverside datatable with no luck. editData keeps giving me errors/NA. I also have tried indexing the serverside table and placing the changed value inside of it, with no luck. I'll post my code below with some comments for specifics..

library(shiny)
library(DT)
library(data.table)
source('~/camo/camo/R/settings.R')
source('~/camo/camo/etl.R')

# Define UI ----
ui <- fluidPage(
  titlePanel("PAlpha"),
  mainPanel(
    fluidRow(
      tabsetPanel(id = 'tpanel',
                  type = "tabs",
                  tabPanel("Alpha", plotOutput("plot1")),
                  tabPanel("Beta", plotOutput("plot2")),
                  tabPanel("Charlie",  plotOutput("plot3")),
                  tabPanel("Delta", plotOutput("plot4")))
    ),
    fluidRow(
      splitLayout(
        dateInput("sdate", "Start Date"),
        dateInput("edate", "End Date"),
        textInput("gmin", "Global Minimum"),
        textInput("gmax", "Global Maximum") 
      )
    ),
    fluidRow(
      splitLayout(
        textInput("groupInp", NULL, placeholder = "New Group"),
        actionButton("addGrpBtn", "Add Group"),
        textInput("tickerInp", NULL, placeholder = "New Ticker"),
        actionButton("addTickerBtn", "Add Ticker")
      )
    ),
    fluidRow(
      splitLayout(
        DT::dataTableOutput('groupsTable'),
        DT::dataTableOutput('groupTickers')
      ),
      verbatimTextOutput("print")
    )
  )
)

# Define server logic ----
server <- function(input, output) {
  port_proxy <- dataTableProxy('groupsTable')
  rv <- reactiveValues(
    portfolio = data.frame('Group' = c('Portfolio'), 'Minimum Weight' = c(0), 'Maximum Weight' = c(0), 'Type' = c('-')),
    groups = list(group1 = data.frame('Group' = c('Ticker'), 'Minimum Weight' = c(0), 'Maximum Weight' = c(0), 'Type' = c('-'))),
    deletedRows  = NULL, 
    deletedRowIndices = list()
  )
  output$groupsTable <- DT::renderDataTable(
    # Add the delete button column
    deleteButtonColumn(rv$portfolio, 'delete_button')
  )
  output$print <- renderPrint({
    rv$portfolio
  })

  ############## LISTENERS ################

  observeEvent(input$deletePressed, {
    rowNum <- parseDeleteEvent(input$deletePressed)
    dataRow <- rv$portfolio[rowNum,]
    # Put the deleted row into a data frame so we can undo
    # Last item deleted is in position 1
    rv$deletedRows <- rbind(dataRow, rv$deletedRows)
    rv$deletedRowIndices <- append(rv$deletedRowIndices, rowNum, after = 0)

    # Delete the row from the data frame
    rv$portfolio <- rv$portfolio[-rowNum,]
  })

  observeEvent(input$addGrpBtn, {
    row <- data.frame('Group' = c(input$groupInp), 
                      'Minimum Weight' = c(0),
                      'Maximum Weight' = c(0), 
                      'Type' = c('-'))
    rv$portfolio <- addRowAt(rv$portfolio, row, nrow(rv$portfolio))
  })

  observeEvent(input$groupsTable_cell_edit,{
    info <- str(input$groupsTable_cell_edit)
    i <- info$row
    j <- info$col
    v <- info$value
    rv$portfolio <- editData(rv$portfolio, input$groupsTable_cell_edit) # doesn't work see below
    # Warning in DT::coerceValue(v, data[i, j, drop = TRUE]) :
    #   New value(s) "test" not in the original factor levels: "Portfolio"; will be coerced to NA.
    # rv$portfolio[i,j] <- input$groupsTable_cell_edit$value
    # rv$portfolio[i,j] <- v #doesn't work

  })

}

addRowAt <- function(df, row, i) {
  # Slow but easy to understand
  if (i > 1) {
    rbind(df[1:(i - 1), ], row, df[-(1:(i - 1)), ])
  } else {
    rbind(row, df)
  }
}

deleteButtonColumn <- function(df, id, ...) {
  # function to create one action button as string
  f <- function(i) {
    # https://shiny.rstudio.com/articles/communicating-with-js.html
    as.character(actionLink(paste(id, i, sep="_"), label = 'Delete', icon = icon('trash'),
                            onclick = 'Shiny.setInputValue(\"deletePressed\",  this.id, {priority: "event"})'))
  }

  deleteCol <- unlist(lapply(seq_len(nrow(df)), f))
  # Return a data table

  DT::datatable(cbind(' ' = deleteCol, df),
                # Need to disable escaping for html as string to work
                escape = FALSE,
                editable = 'cell',
                selection = 'single',
                rownames = FALSE,
                class = 'compact',
                options = list(
                  # Disable sorting for the delete column
                  dom = 't',
                  columnDefs = list(list(targets = 1, sortable = FALSE))
                ))
}

parseDeleteEvent <- function(idstr) {
  res <- as.integer(sub(".*_([0-9]+)", "\\1", idstr))
  if (! is.na(res)) res
}

# Run the app ----
shinyApp(ui = ui, server = server)

Answer 1

As far as I have looked, there is no ready-to-go solution available. You could try to use rhandsontable . It does not provide all the functionality of the DT table, however it allows for the editing. Last time I tried using it there were some minor issues in some edge cases. (Trying to save different data type or something similar.)

Alternatively you can do the stuff manually, along these lines. This is the minimal working example of editing the underlying data frame. Currently I overwrite it every time the user clicks on the table, you would need to change that to handle normal user behavior. It is meant merely as a proof of concept.

library(DT)
library(shiny)

ui <- fluidPage(
    DT::dataTableOutput("test")
)
myDF <- iris[1:10,]
js <- c("table.on('click.dt','tr', function() {",
        "    var a = table.data();",
        "    var data = []",
        "    for (i=0; i!=a.length; i++) {",
        "         data = data.concat(a[i]) ",
        "    };",
        "Shiny.setInputValue('dataChange', data)",
        "})")

server <- function(input, output) {

    output$test <- DT::renderDataTable(
        myDF,
        editable='cell',
        callback=JS(js)
    )
    observeEvent(input$dataChange, {
        res <- cbind.data.frame(split(input$dataChange, rep(1:6, times=length(input$dataChange)/6)),
                                stringsAsFactors=F)
        colNumbers <- res[,1]
        res <- res[,2:ncol(res)]
        colnames(res) <- colnames(myDF)
        myDF <<- res
        print(myDF)
    })
}

shinyApp(ui = ui, server = server)