To make your app easier to understand, I first pulled out the repeated code:
default <- data.frame(
Parameter = c("A", "B", "C"),
Min = c(10, 20, 30),
Max = c(20, 30, 40),
Selected1 = c(0, 0, 0),
Selected2 = c(0, 0, 0),
Selected3 = c(0, 0, 0),
Selected4 = c(0, 0, 0),
Selected5 = c(0, 0, 0)
)
quality_control <- function(df, dfOld) {
qc_col <- function(col) {
ok <- df[[col]] >= df$Min & df[[col]] <= df$Max
ifelse(ok, df[[col]], dfOld[[col]])
}
df$Selected1 <- qc_col("Selected1")
df$Selected2 <- qc_col("Selected2")
df$Selected3 <- qc_col("Selected3")
df$Selected4 <- qc_col("Selected4")
df$Selected5 <- qc_col("Selected5")
df
}
(quality_control() could be further simplified but this at least makes it easy to see what the basic strategy is)
Then the app just about fits on a single screen:
library(shiny)
library(rhandsontable)
ui <- fluidPage(
rHandsontableOutput("table"),
actionButton("reset", "Reset!")
)
server <- function(input, output, session) {
df <- reactiveValues(cur = default, old = default, i = 1)
observeEvent(input$reset, {
df$cur <- default
df$old <- default
})
observeEvent(input$table, {
message("Running QC")
df_new <- quality_control(hot_to_r(input$table), df$old)
df$i <- df$i + 1
df$old <- df$cur
df$cur <- df_new
})
output$table <- renderRHandsontable({
message("Rendering table")
df$i
rhandsontable(df$cur) %>%
hot_col("Parameter", readOnly = TRUE) %>%
hot_validate_numeric("Min", min = 1, max = 50, allowInvalid = FALSE) %>%
hot_validate_numeric("Max", min = 1, max = 50, allowInvalid = FALSE)
})
}
shinyApp(ui, server)
I took me a few tries to get this working — the problem is that you can't rely on usual reactivity, because the client side and server side data might be different, so you need some way to force rhandsontable to redraw, so used another reactive value (i) that I just incremented every time. I I think this suggests that rhandsontable is missing something (maybe updateRHandsontable()?); currently I don't think there's any way to solve your problem using idiomatic shiny code.
You could continue to use <<-, but this feels even less idiomatic to me:
server <- function(input, output, session) {
i <- reactiveVal(0)
dfOld <- df <- default
observeEvent(input$reset, {
dfOld <<- df <<- default
})
observeEvent(input$table, {
message("Running QC")
dfNew <- quality_control(hot_to_r(input$table), dfOld)
dfOld <<- df
df <<- dfNew
i(i() + 1)
})
output$table <- renderRHandsontable({
message("Rendering table")
rhandsontable(df) %>%
hot_col("Parameter", readOnly = TRUE) %>%
hot_validate_numeric("Min", min = 1, max = 50, allowInvalid = FALSE) %>%
hot_validate_numeric("Max", min = 1, max = 50, allowInvalid = FALSE)
})
}