2

ユーザーが (フィルター処理された) テーブルのいくつかの行を選択し、元のデータで選択された行から値を変更できるようにしたいと考えています。

以下の例を見てください。ほとんどそこにいますが、actionButton選択されていないいくつかの行が変更され、理由がわかりません。

レプレックス:

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)

エラーgif

これがワークフローになります。 ワークフロー

4

1 に答える 1