根据 Shiny 中的选定行更改数据值
Change data values based on selected rows in Shiny
我想让用户 select 一些行(已过滤)table,然后更改原始数据中那些 select 编辑行的值。
请看下面的示例,我差不多已经完成了,但是 actionButton
更改了一些未 select 的行,我不确定为什么。
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)
工作流程如下:
这是一种方法。我用 reactiveValues
创建了 rv
来保存你的数据,这些数据可以通过 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,{
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
})
}
或者,与其在每个 observeEvent
中使用两个语句将状态更改为 TRUE 或 FALSE,还可以简化如下:
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())
})
也可以进行其他修改。但是,我尽量不更改您已有的任何其他内容。让我知道这是否是您想要的。
我想让用户 select 一些行(已过滤)table,然后更改原始数据中那些 select 编辑行的值。
请看下面的示例,我差不多已经完成了,但是 actionButton
更改了一些未 select 的行,我不确定为什么。
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)
工作流程如下:
这是一种方法。我用 reactiveValues
创建了 rv
来保存你的数据,这些数据可以通过 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,{
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
})
}
或者,与其在每个 observeEvent
中使用两个语句将状态更改为 TRUE 或 FALSE,还可以简化如下:
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())
})
也可以进行其他修改。但是,我尽量不更改您已有的任何其他内容。让我知道这是否是您想要的。