Change data values based on selected rows in Shiny

Question

I want to let the user select some rows of a (filtered) table and then change a value from those selected rows in the original data.

Please look at the example below, I´m almost there but the actionButton changes some rows that are not selected and I´m not sure why.

REPREX:

library(shiny)
library(reactable)

ID <- c("430276", "430277", "430278", "430279", "430280", "430281", "430282", "410873")
DATE <- as.Date(c("2021/02/01", "2021/02/01", "2021/04/01", "2021/04/01", "2021/04/01", "2020/10/01", "2021/05/01", "2020/09/01"))
STOP <- c(FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,TRUE,TRUE)
raw_data <- data.frame(ID, DATE, STOP)

ui <- fluidPage(

    titlePanel("Update Table"),

    sidebarLayout(
        sidebarPanel(
            uiOutput("idDateRange"), HTML("<br/>"),
            uiOutput("idStop"), HTML("<br/>"),
            uiOutput("idNoStop")
        ),

        mainPanel(
            reactableOutput("table")
        )
    )
)

server <- function(input, output) {

    output$idDateRange <- renderUI({
        dateRangeInput(
            "idDateRange",
            label = "Date:",
            min = "2020/09/01",
            max = "2021/09/01",
            start = "2020/09/01",
            end = "2021/09/01",
            weekstart = 1, separator = "to", format = "dd/M/yyyy"
        )
    })
    
    output$idStop <- renderUI({
        actionButton(
            "idStop",
            label = "STOP"
        )
    })
    
    output$idNoStop <- renderUI({
        actionButton(
            "idNoStop",
            label = "UN-STOP"
        )
    })
    
    data_filtered <- reactive({
        raw_data[raw_data$DATE >= input$idDateRange[1] & raw_data$DATE <= input$idDateRange[2], ]
    })
            
    output$table <- renderReactable({
        reactable(data_filtered(),
                  selection = "multiple", 
                  onClick = "select")
    })
    
    # This just gets the index of the rows selected by user
    table_selected <- reactive(getReactableState("table", "selected"))

    observeEvent(input$idStop,{
        
        df <- data_filtered()
        ind <- table_selected()
        df[ind, 3] <- TRUE
        
        updateReactable("table", data = df )
        
        # this does not work?
        raw_data[raw_data$ID == df$ID, "STOP"] <- TRUE
    })
    
    observeEvent(input$idNoStop,{
        
        df <- data_filtered()
        ind <- table_selected()
        df[ind, 3] <- FALSE
        
        updateReactable("table", data = df )
        
        raw_data[raw_data$ID == df$ID, "STOP"] <- FALSE
    })
    
}

shinyApp(ui = ui, server = server)

This would be the workflow:

Answer 1

Here is one approach. I created rv with reactiveValues to hold your data, which can be accessed by rv$df. The default is raw_data.

In addition, it appears you want to update specific values in your data frame based on the ID contained in the selected rows. For this part, you could try:

rv$df$ID %in% df[ind, "ID"]

to include only rows that share the same ID to change the status in.

Here is the modified server function:

server <- function(input, output) {
  
  rv <- reactiveValues(df = raw_data)
  
  output$idDateRange <- renderUI({
    dateRangeInput(
      "idDateRange",
      label = "Date:",
      min = "2020/09/01",
      max = "2021/09/01",
      start = "2020/09/01",
      end = "2021/09/01",
      weekstart = 1, separator = "to", format = "dd/M/yyyy"
    )
  })
  
  output$idStop <- renderUI({
    actionButton(
      "idStop",
      label = "STOP"
    )
  })
  
  output$idNoStop <- renderUI({
    actionButton(
      "idNoStop",
      label = "UN-STOP"
    )
  })
  
  data_filtered <- reactive({
    rv$df[rv$df$DATE >= input$idDateRange[1] & rv$df$DATE <= input$idDateRange[2], ]
  })
  
  output$table <- renderReactable({
    reactable(data_filtered(),
              selection = "multiple", 
              onClick = "select")
  })
  
  # This just gets the index of the rows selected by user
  table_selected <- reactive(getReactableState("table", "selected"))
  
  observeEvent(input$idStop,{
    
    df <- data_filtered()
    ind <- table_selected()
    df[ind, 3] <- TRUE
    
    updateReactable("table", data = df )
    
    rv$df[rv$df$ID %in% df[ind, "ID"], "STOP"] <- TRUE
  })
  
  observeEvent(input$idNoStop,{
    
    df <- data_filtered()
    ind <- table_selected()
    df[ind, 3] <- FALSE
    
    updateReactable("table", data = df )
    
    rv$df[rv$df$ID %in% df[ind, "ID"], "STOP"] <- FALSE
  })
  
}

Or, instead of having two statements to change status to TRUE or FALSE in each observeEvent, you could also simplify as follows:

observeEvent(input$idStop,{
  rv$df[rv$df$ID %in% data_filtered()[table_selected(), "ID"], "STOP"] <- TRUE
  updateReactable("table", data = data_filtered())
})

observeEvent(input$idNoStop,{
  rv$df[rv$df$ID %in% data_filtered()[table_selected(), "ID"], "STOP"] <- FALSE
  updateReactable("table", data = data_filtered())
})

Additional modifications could be pursued as well. However, I tried not to change anything else you had in place. Let me know if this is what you had in mind.