r - 更新 R Shiny 中的行后更新绘图
问题描述
最后,我想在修改数据框的记录后更新我的情节。现在,当按下提交按钮时,下面的代码成功地更新了带有标签的选定点,但是,鉴于我正在过滤行以仅包含标签所在的行,我不确定为什么该图不会重新渲染不见了。
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)
我确信我忽略了一些明显的东西,但这并没有跳出来给我,而且我几天来一直在努力解决这个问题。
解决方案
那是因为您更新的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)
推荐阅读
- mysql - How to select from two tables in a specific order to associate idT1-idT2
- json - 使用 Power Query 和 JSON 转换记录
- ios - 使用故事板引用自定义标签栏控制器
- python - python脚本中的远程操作(SSH)打印输出是否阻塞?
- c++ - c++ 之后如何打印 1-10 如果我输入其中一个数字将消失
- dvajs - 获取同步的最佳实践
- c++ - 在这些例子中,哪些是需要转换的?
- javascript - 如何从控制台应用程序修改域的本地存储内容?
- post - Flutter - Handle status code 302 in POST request
- android - Android Jetpack Navigation 组件问题,将启动片段作为根目的地