Ok, I solved it: The solution is to avoid using a "classical" function call to UpdateValue(parameters) and use a reactive value and an observer instead. I.e. to (1) have a reactive variable "UpdateCellTrigger" which is a dataframe containing the function parameters (i.e. the indices of the selected cell) and (2) implement the UpdateValue() function as an observer of this reactive variable (see below for code). It seems that mixing reactive programming and standard R function calls can lead problems - maybe related to the timing of the execution of differents parts of the code. It seems sticking as close as possible to the reactive programming approach avoids some of these issues.
Cheers!
library(shiny)
library(DT)
ui <- fluidPage(
#A minimal GUI
mainPanel(
DT::dataTableOutput("DemoTable")
)
)
server <- function(input, output) {
#A reactive data frame with some initialization
DemoTable <- data.frame(
value1 = runif(0,1,n=4),
value2 = runif(0,1,n=4)
)
makeReactiveBinding("DemoTable")
#Link the demo table reactive to the output datatable
output$DemoTable = DT::renderDataTable({
MyDT <- datatable(data=DemoTable,selection=list(mode="single",target="cell"))
return(MyDT)
})
#Does not work:
#A function to change the value in the selected cell
# UpdateValue <- function(row,col) {
# tmp <- DemoTable
# tmp[row,col] <- runif(0,1,n=1)
# DemoTable <<- tmp
# }
#Does work:
#1. Define a reactive that acts as a trigger for the function
#call and transfers the function arguments
UpdateCellTrigger <- data.frame(
RowIndex = -1,
ColIndex = -1
)
makeReactiveBinding("UpdateCellTrigger")
#2. Define the update function as an observer
#of the trigger
observe({
#Ignore if trigger is not set
if ( UpdateCellTrigger$RowIndex == -1 ) return()
#Extract selected cell indices
RowIndex <- UpdateCellTrigger$RowIndex
ColIndex <- UpdateCellTrigger$ColIndex
#Reset trigger
UpdateCellTrigger$RowIndex <<- -1
UpdateCellTrigger$ColIndex <<- -1
#Update values of table
DemoTable[RowIndex,ColIndex] <<- runif(0,1,n=1)
})
#Observe cell select event of table
AnyCellSelected <- reactive({!is.null(input$DemoTable_cells_selected)})
observe({
#Catch some irrelavant conditions
if ( !AnyCellSelected() ) return()
DemoTableSelectedCell <- input$DemoTable_cells_selected
if ( nrow(DemoTableSelectedCell) == 0 ) return()
#Extract selected cell indices
RowSelected <- DemoTableSelectedCell[1,1]
ColSelected <- DemoTableSelectedCell[1,2]
#Unselect the selected cell to avoid repeated call of this
#observe() function - does not work
DTproxy <- DT::dataTableProxy(outputId="DemoTable")
DT::selectCells(DTproxy, NULL)
#Report to console whether this function is called for
#debugging purpose
print("called")
#Change the value in the selected cell on selection
UpdateCellTrigger <<- data.frame(
RowIndex = RowSelected,
ColIndex = ColSelected
)
})
}
# Run the application
shinyApp(ui = ui, server = server)