根据Shiny中的选定行更改数据值

问题描述

我想让用户选择（已过滤）表的某些行，然后从原始数据中的那些选定行中更改一个值。

请看下面的示例，我几乎在那儿，但是actionButton更改了一些未选择的行，我不确定为什么。

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","2020/10/01","2021/05/01","2020/09/01"))
STOP <- c(FALSE,FALSE,TRUE,TRUE)
raw_data <- data.frame(ID,DATE,STOP)

ui <- fluidPage(

    titlePanel("Update Table"),sidebarLayout(
        sidebarPanel(
            uIoUtput("idDaterange"),HTML("<br/>"),uIoUtput("idStop"),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,3] <- FALSE
        
        updateReactable("table",data = df )
        
        raw_data[raw_data$ID == df$ID,"STOP"] <- FALSE
    })
    
}

shinyApp(ui = ui,server = server)

这将是工作流程：

解决方法

这是一种方法。我用rv创建了reactiveValues来保存您的数据，rv$df可以访问它们。默认值为raw_data。

此外，您似乎想根据所选行中包含的ID更新数据框中的特定值。对于这一部分，您可以尝试：

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

仅包含共享同一ID的行以更改状态。

这是修改后的server函数：

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,3] <- FALSE
    
    updateReactable("table","STOP"] <- FALSE
  })
  
}

或者，除了在每个observeEvent中不使用两个语句将状态更改为TRUE或FALSE之外，还可以简化如下操作：

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

observeEvent(input$idNoStop,"STOP"] <- FALSE
  updateReactable("table",data = data_filtered())
})

也可以进行其他修改。但是，我尝试不更改您已有的其他任何内容。让我知道这是否是您的想法。