更新R Shiny中的行后更新绘图

Question

最后，我想在修改数据帧的记录后更新我的绘图。现在，当按下提交按钮时，下面的代码成功地用标签更新了选定的点，但是，我不确定为什么绘图不重新渲染，因为我正在过滤行，只包括缺少标签的行。

library(ggplot2)
library(Cairo)   # For nicer ggplot2 output when deployed on Linux
suppressPackageStartupMessages(library(dplyr))
# We'll use a subset of the mtcars data set, with fewer columns
# so that it prints nicely
mtcars2 <- mtcars[, c("mpg", "cyl", "disp", "hp", "wt", "am", "gear")]
mtcars2$label = NA
mtcars2$id = 1:nrow(mtcars2)

ui <- fluidPage(
fluidRow(
column(width = 12,
plotOutput("plot1", height = 300,
# Equivalent to: click = clickOpts(id = "plot_click")
click = "plot1_click",
brush = brushOpts(
id = "plot1_brush"
)
)
)
),
br(),
fluidRow(
column(width = 6,
h4("Selected/Brushed points"),
verbatimTextOutput("brush_info")
),
column(width = 6,
h4("Annotation Tool"),
br(),
textInput("tag", "Label to apply"),
br(),
actionButton('update', 'Add Label')
)
)
)
server <- function(input, output, session) {

filtered_df = reactive({mtcars2 %>% filter(is.na(label))})

output$plot1 <- renderPlot({
ggplot(filtered_df(), aes(wt, mpg)) + geom_point()
})

# output$click_info <- renderPrint({
#   # Because it's a ggplot2, we don't need to supply xvar or yvar; if this
#   # were a base graphics plot, we'd need those.
#   nearPoints(mtcars2, input$plot1_click, addDist = TRUE)
# })

output$brush_info <- renderPrint({
brushedPoints(mtcars2, input$plot1_brush)
})

observeEvent(input$update, {
df = brushedPoints(mtcars2, input$plot1_brush)
mtcars2[mtcars2$id %in% df$id, "label"] <<- input$tag
# clear out the input tag
updateTextInput(session, "tag", value="")
# reset the brush
session$resetBrush("plot1_brush")

mtcars2 <<- mtcars2
})


}
shinyApp(ui, server)

我确信我忽略了一些显而易见的事情，但这并没有让我跳出来，几天来我一直在思考这个问题。

Answer 1

这是因为您更新的mtcars2数据帧在observeEvent之外不可用。尝试创建一个reactiveValues对象，如下所示。

mtcars2 <- mtcars[, c("mpg", "cyl", "disp", "hp", "wt", "am", "gear")]
mtcars2$label = NA
mtcars2$id = 1:nrow(mtcars2)

ui <- fluidPage(
fluidRow(
column(width = 12,
plotOutput("plot1", height = 300,
# Equivalent to: click = clickOpts(id = "plot_click")
click = "plot1_click",
brush = brushOpts(
id = "plot1_brush"
)
)
)
),
br(),
fluidRow(
column(width = 6,
h4("Selected/Brushed points"),
verbatimTextOutput("brush_info")
),
column(width = 6,
h4("Annotation Tool"),
br(),
textInput("tag", "Label to apply"),
br(),
actionButton('update', 'Add Label'),
br(),
DTOutput("tb1")
)
)
)
server <- function(input, output, session) {
mt <- reactiveValues(data=mtcars2)
filtered_df = reactive({mt$data %>% filter(is.na(label))})

output$plot1 <- renderPlot({
ggplot(filtered_df(), aes(wt, mpg)) + geom_point()
})

output$brush_info <- renderPrint({
brushedPoints(mtcars2, input$plot1_brush)
})

observeEvent(input$update, {
df = brushedPoints(mtcars2, input$plot1_brush)
mtcars2[mtcars2$id %in% df$id, "label"] <<- input$tag
# clear out the input tag
updateTextInput(session, "tag", value="")
# reset the brush
session$resetBrush("plot1_brush")

#mtcars2 <<- mtcars2
mt$data <- mtcars2
output$tb1 <- renderDT(mt$data)
})

}
shinyApp(ui, server)