我如何确保闪亮的反应图仅在所有其他反应完成更改后才会更改？
How do I make sure that a shiny reactive plot only changes once all other reactives finish changing?
我有一个闪亮的应用程序，用户可以在其中选择一组输入，例如 x 范围、y 范围、缩放类型以及通过下拉列表选择数据集的特定子集。
这一切都是通过使用反应来完成的。 X 和 Y 范围滑块输入对数据集选择的变化做出反应，因为必须再次找到最小值和最大值。这可能需要大约 1-2 秒，而闪亮的应用程序正在运行并且用户在下拉列表中选择不同的选项。在那 1-2 秒内，绘图切换为使用旧的 x 和 y 范围绘制选定的新数据子集，然后在 x 和 y 范围滑块发生变化后快速切换到正确的绘图。
解决方法是通过隔离其他所有内容来刷新按钮上的绘图。但是有没有办法让情节对变化做出反应，而只是等到所有依赖的东西都完成计算？
谢谢
剧情是这样的：
output$plot1 <- rCharts::renderChart2({
if(!is.null(input$date_of_interest) &&
!is.null(input$xrange) &&
!is.null(input$yrange) &&
!is.null(data()) &&
isolate(valid_date_of_interest())) {
filtered_data<- dplyr::filter(isolate(data()), id==input$choice)
p <- tryCatch(plot_high_chart(
data,
first_date_of_interest = input$date_of_interest,
ylim = input$yrange,
xlim = input$xrange),
error = function(e) e,
warning = function(w) w)
if(!inherits(p, "error") && !inherits(p, "warning")) {
return(p)
}
}
return(rCharts::Highcharts$new())
})
和x范围（y范围相似）：
output$xrange <- renderUI({
if(!is.null(input$date_of_interest) &&
!is.null(input$choice) &&
!is.null(valid_date_of_interest()) &&
isolate(valid_date_of_interest())) {
temp_data <- dplyr::filter(isolate(data()), date == input$date_of_interest)
temp <- data.table::data.table(temp_data, key = "child.id")
the_days <- as.double(as.Date(temp$last.tradeable.dt) - as.Date(temp$date))
min_days <- min(the_days,na.rm=TRUE)
max_days <- max(the_days,na.rm=TRUE)
sliderInput("xrange",
"Days Range (X Axis)",
step = 1,
min = 0,
max = max_days + 10,
value = c(min_days,max_days)
)
}
})
和输入选项：
output$choice<- renderUI({
selectInput("choice",
"Choose:",
unique(data$id),
selected = 1
)
})
一些实施方向和建议会很有用。我考虑过使用 x_range_updated、y_range_updated 等全局变量，在 output$choice 的代码中设置为 false，然后在 output$xrange 的代码中设置为 true，等等。然后让 plot1 取决于它们是否为真。解决此问题的其他建议将不胜感激。
编辑 2019-02-14
自 Shiny 1.0.0（在我最初写这个答案后发布）以来，现在有一个 debounce 函数添加了帮助完成此类任务的功能。在大多数情况下，这避免了对我最初编写的代码的需要，尽管在引擎盖下它以类似的方式工作。但是，据我所知，debounce 没有提供任何方法来按照我在此处所做的操作使用重绘操作按钮来缩短延迟。因此，我创建了一个提供此功能的 debounce 的修改版本：
library(shiny)
library(magrittr)
# Redefined in global namespace since it's not exported from shiny
`%OR%` <- shiny:::`%OR%`
debounce_sc <- function(r, millis, priority = 100, domain = getDefaultReactiveDomain(), short_circuit = NULL)
{
force(r)
force(millis)
if (!is.function(millis)) {
origMillis <- millis
millis <- function() origMillis
}
v <- reactiveValues(trigger = NULL, when = NULL)
firstRun <- TRUE
observe({
r()
if (firstRun) {
firstRun <<- FALSE
return()
}
v$when <- Sys.time() + millis()/1000
}, label = "debounce tracker", domain = domain, priority = priority)
# New code here to short circuit the timer when the short_circuit reactive
# triggers
if (inherits(short_circuit, "reactive")) {
observe({
short_circuit()
v$when <- Sys.time()
}, label = "debounce short circuit", domain = domain, priority = priority)
}
# New code ends
observe({
if (is.null(v$when))
return()
now <- Sys.time()
if (now >= v$when) {
v$trigger <- isolate(v$trigger %OR% 0) %% 999999999 +
1
v$when <- NULL
}
else {
invalidateLater((v$when - now) * 1000)
}
}, label = "debounce timer", domain = domain, priority = priority)
er <- eventReactive(v$trigger, {
r()
}, label = "debounce result", ignoreNULL = FALSE, domain = domain)
primer <- observe({
primer$destroy()
er()
}, label = "debounce primer", domain = domain, priority = priority)
er
}
这就允许简化闪亮的应用程序。我已切换到单文件工作模式，但 UI 与原始模式保持一致。
ui <- fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
selectInput("column", "Column", colnames(faithful), selected = "waiting"),
actionButton("redraw", "Redraw")
),
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output, session) {
reac <- reactive(list(bins = input$bins, column = input$column)) %>%
debounce_sc(5000, short_circuit = reactive(input$redraw))
# Only triggered by the debounced reactive
output$distPlot <- renderPlot({
x <- faithful[, reac()$column]
bins <- seq(min(x), max(x), length.out = reac()$bins + 1)
hist(x, breaks = bins, col = 'darkgray', border = 'white',
main = sprintf("Histogram of %s", reac()$column))
})
}
shinyApp(ui, server)
原始版本（闪亮 1.0.0 之前）
您没有提供可重现的示例，因此我使用了一些基于 RStudio 中默认的 Shiny faithful 示例的内容。我得到的解决方案在输入更改和重新绘制图形之间始终有一个（可配置的）5 秒延迟。输入的每次变化都会重置计时器。对于不耐烦的人，还有一个重绘按钮，可以立即重绘图形。每次输入更改或计时器滴答时，反应值 'redraw' 和输入的值都会显示在控制台中。这应该被删除以供生产使用。希望这能满足您的需求！
library(shiny)
shinyUI(fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
selectInput("column", "Column", colnames(faithful), selected = "waiting"),
actionButton("redraw", "Redraw")
),
mainPanel(
plotOutput("distPlot")
)
)
))
server.R
library(shiny)
shinyServer(function(input, output, session) {
reac <- reactiveValues(redraw = TRUE, bins = isolate(input$bins), column = isolate(input$column))
# If any inputs are changed, set the redraw parameter to FALSE
observe({
input$bins
input$column
reac$redraw <- FALSE
})
# This event will also fire for any inputs, but will also fire for
# a timer and with the 'redraw now' button.
# The net effect is that when an input is changed, a 5 second timer
# is started. This will be reset any time that a further input is
# changed. If it is allowed to lapse (or if the button is pressed)
# then the inputs are copied into the reactiveValues which in turn
# trigger the plot to be redrawn.
observe({
invalidateLater(5000, session)
input$bins
input$column
input$redraw
isolate(cat(reac$redraw, input$bins, input$column, "\n"))
if (isolate(reac$redraw)) {
reac$bins <- input$bins
reac$column <- input$column
} else {
isolate(reac$redraw <- TRUE)
}
})
# Only triggered when the copies of the inputs in reac are updated
# by the code above
output$distPlot <- renderPlot({
x <- faithful[, reac$column]
bins <- seq(min(x), max(x), length.out = reac$bins + 1)
hist(x, breaks = bins, col = 'darkgray', border = 'white',
main = sprintf("Histogram of %s", reac$column))
})
})
我有一个闪亮的应用程序，用户可以在其中选择一组输入，例如 x 范围、y 范围、缩放类型以及通过下拉列表选择数据集的特定子集。
这一切都是通过使用反应来完成的。 X 和 Y 范围滑块输入对数据集选择的变化做出反应，因为必须再次找到最小值和最大值。这可能需要大约 1-2 秒，而闪亮的应用程序正在运行并且用户在下拉列表中选择不同的选项。在那 1-2 秒内，绘图切换为使用旧的 x 和 y 范围绘制选定的新数据子集，然后在 x 和 y 范围滑块发生变化后快速切换到正确的绘图。
解决方法是通过隔离其他所有内容来刷新按钮上的绘图。但是有没有办法让情节对变化做出反应，而只是等到所有依赖的东西都完成计算？
谢谢
剧情是这样的：
output$plot1 <- rCharts::renderChart2({
if(!is.null(input$date_of_interest) &&
!is.null(input$xrange) &&
!is.null(input$yrange) &&
!is.null(data()) &&
isolate(valid_date_of_interest())) {
filtered_data<- dplyr::filter(isolate(data()), id==input$choice)
p <- tryCatch(plot_high_chart(
data,
first_date_of_interest = input$date_of_interest,
ylim = input$yrange,
xlim = input$xrange),
error = function(e) e,
warning = function(w) w)
if(!inherits(p, "error") && !inherits(p, "warning")) {
return(p)
}
}
return(rCharts::Highcharts$new())
})
和x范围（y范围相似）：
output$xrange <- renderUI({
if(!is.null(input$date_of_interest) &&
!is.null(input$choice) &&
!is.null(valid_date_of_interest()) &&
isolate(valid_date_of_interest())) {
temp_data <- dplyr::filter(isolate(data()), date == input$date_of_interest)
temp <- data.table::data.table(temp_data, key = "child.id")
the_days <- as.double(as.Date(temp$last.tradeable.dt) - as.Date(temp$date))
min_days <- min(the_days,na.rm=TRUE)
max_days <- max(the_days,na.rm=TRUE)
sliderInput("xrange",
"Days Range (X Axis)",
step = 1,
min = 0,
max = max_days + 10,
value = c(min_days,max_days)
)
}
})
和输入选项：
output$choice<- renderUI({
selectInput("choice",
"Choose:",
unique(data$id),
selected = 1
)
})
一些实施方向和建议会很有用。我考虑过使用 x_range_updated、y_range_updated 等全局变量，在 output$choice 的代码中设置为 false，然后在 output$xrange 的代码中设置为 true，等等。然后让 plot1 取决于它们是否为真。解决此问题的其他建议将不胜感激。
编辑 2019-02-14
自 Shiny 1.0.0（在我最初写这个答案后发布）以来，现在有一个 debounce 函数添加了帮助完成此类任务的功能。在大多数情况下，这避免了对我最初编写的代码的需要，尽管在引擎盖下它以类似的方式工作。但是，据我所知，debounce 没有提供任何方法来按照我在此处所做的操作使用重绘操作按钮来缩短延迟。因此，我创建了一个提供此功能的 debounce 的修改版本：
library(shiny)
library(magrittr)
# Redefined in global namespace since it's not exported from shiny
`%OR%` <- shiny:::`%OR%`
debounce_sc <- function(r, millis, priority = 100, domain = getDefaultReactiveDomain(), short_circuit = NULL)
{
force(r)
force(millis)
if (!is.function(millis)) {
origMillis <- millis
millis <- function() origMillis
}
v <- reactiveValues(trigger = NULL, when = NULL)
firstRun <- TRUE
observe({
r()
if (firstRun) {
firstRun <<- FALSE
return()
}
v$when <- Sys.time() + millis()/1000
}, label = "debounce tracker", domain = domain, priority = priority)
# New code here to short circuit the timer when the short_circuit reactive
# triggers
if (inherits(short_circuit, "reactive")) {
observe({
short_circuit()
v$when <- Sys.time()
}, label = "debounce short circuit", domain = domain, priority = priority)
}
# New code ends
observe({
if (is.null(v$when))
return()
now <- Sys.time()
if (now >= v$when) {
v$trigger <- isolate(v$trigger %OR% 0) %% 999999999 +
1
v$when <- NULL
}
else {
invalidateLater((v$when - now) * 1000)
}
}, label = "debounce timer", domain = domain, priority = priority)
er <- eventReactive(v$trigger, {
r()
}, label = "debounce result", ignoreNULL = FALSE, domain = domain)
primer <- observe({
primer$destroy()
er()
}, label = "debounce primer", domain = domain, priority = priority)
er
}
这就允许简化闪亮的应用程序。我已切换到单文件工作模式，但 UI 与原始模式保持一致。
ui <- fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
selectInput("column", "Column", colnames(faithful), selected = "waiting"),
actionButton("redraw", "Redraw")
),
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output, session) {
reac <- reactive(list(bins = input$bins, column = input$column)) %>%
debounce_sc(5000, short_circuit = reactive(input$redraw))
# Only triggered by the debounced reactive
output$distPlot <- renderPlot({
x <- faithful[, reac()$column]
bins <- seq(min(x), max(x), length.out = reac()$bins + 1)
hist(x, breaks = bins, col = 'darkgray', border = 'white',
main = sprintf("Histogram of %s", reac()$column))
})
}
shinyApp(ui, server)
原始版本（闪亮 1.0.0 之前）
您没有提供可重现的示例，因此我使用了一些基于 RStudio 中默认的 Shiny faithful 示例的内容。我得到的解决方案在输入更改和重新绘制图形之间始终有一个（可配置的）5 秒延迟。输入的每次变化都会重置计时器。对于不耐烦的人，还有一个重绘按钮，可以立即重绘图形。每次输入更改或计时器滴答时，反应值 'redraw' 和输入的值都会显示在控制台中。这应该被删除以供生产使用。希望这能满足您的需求！
library(shiny)
shinyUI(fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
selectInput("column", "Column", colnames(faithful), selected = "waiting"),
actionButton("redraw", "Redraw")
),
mainPanel(
plotOutput("distPlot")
)
)
))
server.R
library(shiny)
shinyServer(function(input, output, session) {
reac <- reactiveValues(redraw = TRUE, bins = isolate(input$bins), column = isolate(input$column))
# If any inputs are changed, set the redraw parameter to FALSE
observe({
input$bins
input$column
reac$redraw <- FALSE
})
# This event will also fire for any inputs, but will also fire for
# a timer and with the 'redraw now' button.
# The net effect is that when an input is changed, a 5 second timer
# is started. This will be reset any time that a further input is
# changed. If it is allowed to lapse (or if the button is pressed)
# then the inputs are copied into the reactiveValues which in turn
# trigger the plot to be redrawn.
observe({
invalidateLater(5000, session)
input$bins
input$column
input$redraw
isolate(cat(reac$redraw, input$bins, input$column, "\n"))
if (isolate(reac$redraw)) {
reac$bins <- input$bins
reac$column <- input$column
} else {
isolate(reac$redraw <- TRUE)
}
})
# Only triggered when the copies of the inputs in reac are updated
# by the code above
output$distPlot <- renderPlot({
x <- faithful[, reac$column]
bins <- seq(min(x), max(x), length.out = reac$bins + 1)
hist(x, breaks = bins, col = 'darkgray', border = 'white',
main = sprintf("Histogram of %s", reac$column))
})
})