Resetting dynamic table with actionButton

[GreyMerchant]

Hello,

I have this table that is made by rhandsontable . The table work as intended - all values that are accepted fall within the respective min and max of the row. However, I am having problem resetting the table. What should happen is that the table should be like the original table and I thought an action button with the corresponding table would do it. I am pretty sure something of the <<- assignment is making this more difficult. I added a message to my button to at least see that it is triggering the event.

Any idea how I can get the table to truly reset? Essentially, changing df() back to the original table on the reset button.

library(shiny)
library(rhandsontable)

ui <- fluidPage(rHandsontableOutput('table'),
                actionButton("hard_reset","Reset!"))#,

x <- reactiveValues(transfer = NULL)

server <- function(input, output, session) {
  df <- eventReactive(input$table,  {
    if (is.null(input$table))  {
      dfOld <<-
        df <-
        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)
        )
    } else {
      df <- hot_to_r(input$table)
      #  Quality control
      # Rule for Simulation 1:
      if (all(df$Selected1 >= df$Min |
              df$Selected1 == 0) & all(df$Selected1 <= df$Max)) {
        df$Selected1 <- df$Selected1
      } else {
        df$Selected1 <- dfOld$Selected1
      }
      # Rule for Simulation 2:
      if (all(df$Selected2 >= df$Min |
              df$Selected2 == 0) & all(df$Selected2 <= df$Max)) {
        df$Selected2 <- df$Selected2
      } else {
        df$Selected2 <- dfOld$Selected2
      }
      # Rule for Simulation 3:
      if (all(df$Selected3 >= df$Min |
              df$Selected3 == 0) & all(df$Selected3 <= df$Max)) {
        df$Selected3 <- df$Selected3
      } else {
        df$Selected3 <- dfOld$Selected3
      }
      # Rule for Simulation 4:
      if (all(df$Selected4 >= df$Min |
              df$Selected4 == 0) & all(df$Selected4 <= df$Max)) {
        df$Selected4 <- df$Selected4
      } else {
        df$Selected4 <- dfOld$Selected4
      }
      # Rule for Simulation 5:
      if (all(df$Selected5 >= df$Min |
              df$Selected5 == 0) & all(df$Selected5 <= df$Max)) {
        df$Selected5 <- df$Selected5
      } else {
        df$Selected5 <- dfOld$Selected5
      }
    }
    dfOld <<- df
    
  }, ignoreNULL = F)
  
  output$table <- renderRHandsontable({
    if (is.null(df()))
      return()
    rhandsontable(df()) %>%
      hot_col("Parameter", readOnly = TRUE) %>%
      hot_validate_numeric(
        col = 'Min',
        min = 1,
        max = 50,
        allowInvalid = FALSE
      ) %>%
      hot_validate_numeric(
        col = 'Max',
        min = 1,
        max = 50,
        allowInvalid = FALSE
      )
  })
  
  observeEvent(input$hard_reset, {
    reset_dialog <- modalDialog("A reset has occured")
    showModal(reset_dialog)
    

    x$transfer  <- 
      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))
  df <- x$transfer  
  })
  
}

shinyApp(ui, server)

[hadley]

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)
  })
}

[GreyMerchant]

@hadley thank you for taking the time to reply Your solution is working and it is definitely far more readable than the other code.

The toy problem was adequate to show the fix but I wanted to know how I would go about changing default to a reactive object? In my code, depending on how many selections they want to run there might only be 2 or 5 which means it will not always have all those columns. The big problem I see is that I can't pass a reactive within a reactiveValues call as you have here:

df <- reactiveValues(cur = default, old = default, i = 1)

I am not entirely sure how best to address this problem and if I should even attempt calling it here? I tried to pass an empty data.frame here as well but it is not a fix just yet.

[hadley]

If you wanted default to be a reactive object, you'd just use default() everywhere? I'm not sure I understand the problem.

[GreyMerchant]

I think if I understand you it should look something like the below. It works when I insert 3 within the numericInput() and trigger an action like clicking reset. I am not exactly sure why it is not handling 1 and 2. Code can obviously be written far more succinct.

quality_control <- function(df, dfOld, val_validate) {
  qc_col <- function(col) {
    ok <- df[[col]] >= df$Min & df[[col]] <= df$Max
    ifelse(ok, df[[col]], dfOld[[col]])
  }
  if(val_validate == 1){
    df$selected1 <- qc_col("selected1") 
    df}
  if(val_validate == 2){
    df$selected1 <- qc_col("selected1")
    df$selected2 <- qc_col("selected2")
    df}
  if(val_validate == 3){
    df$selected1 <- qc_col("selected1")
    df$selected2 <- qc_col("selected2")
    df$selected3 <- qc_col("selected3")
    df}
}

library(shiny)
library(rhandsontable)

ui <- fluidPage(
  numericInput("select_count","# of selected", value = 1, min = 1, max = 3, step = 1),
  actionButton("reset", "Reset!"),
  rHandsontableOutput("table")
)

server <- function(input, output, session) {
  
  default <- reactive({
    if(input$select_count == 1){
      df <- data.frame(
        Parameter = c("A", "B", "C"),
        Min = c(10, 20, 30),
        Max = c(20, 30, 40),
        selected1 = c(0, 0, 0))
      df
    }
    if(input$select_count == 2){
      df <- 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))
      df
    }
    if(input$select_count == 3){
      df <- 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))
      df
    }
  })
  

  
  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, input$select_count)
    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)
  })#,ignoreNULL = FALSE)
}

shinyApp(ui, server)