背景：在“闪亮”应用中，我有（i）数据输入文本区域和（ii）滑块。 滑块的值和端点由数据更新，因为滑块的范围应适合数据规模。随后的耗时计算将同时使用文本区域中的数据和滑块中的值。
问题：更改数据后，耗时的计算将执行两次，首先使用滑块的 previous 值（而不是滑块的更新值） ），然后第二次使用滑块的更新值。我的意图是使用滑块的更新值而不是滑块的先前值仅执行一次。
一个最小的示例：下面的R代码演示了问题，它的设置尽可能小。只需复制并粘贴到RStudio中，然后单击“运行应用程序”。您将在屏幕底部看到输出：几秒钟后显示4025，然后几秒钟后显示50。单击重新加载以再次观看。初始输出（即4025）无关紧要。仅打算最终输出（即50）。
其他细微之处：：滑块处于debounce延迟状态，因此其运动不会立即触发耗时的计算。用户应该能够暂时移动滑块，而不会立即触发计算。这对于应用程序很重要，但与双重执行问题密切相关。数据textAreaInput使用actionButton，因此键入文本不会立即触发计算。同样，对于应用程序来说很重要，但与双重执行问题密切相关。
谢谢您的建议！
library(shiny)
library(magrittr) # for pipe operator, %>%, used with debounce().
debounceDelay = 2000 # milliseconds
ui <- fluidPage(
titlePanel("Data affect Slider, both affect Subsequent Long Computation"),
sidebarLayout(
sidebarPanel(
# Data input:
textAreaInput( inputId="dataText" ,
label="Type data, then click Submit:" ,
value="10 20 30 40" ,
width="200px" ,
height="100px" ) ,
actionButton( inputId="dataSubmit" ,
label="Submit Data" ) ,
# Slider input, to be updated by data:
sliderInput( inputId = "slider1" ,
label = HTML("Constant to Add to Mean of Data
(after debounce delay):") ,
min=3000 , max=5000 , value=4000 ,
round=FALSE , step=1 , ticks=FALSE )
) , # end sidebarPanel
mainPanel(
textOutput("theOutput")
)
) # end sidebarLayout
) # end ui fluidPage
server <- function(input, output, session) {
# Parse data values out of data text:
theData = reactive({
input$dataSubmit # establish dependency on dataSubmit button
yText = isolate(input$dataText) # remove dependency on dataText
y = as.numeric(unlist(strsplit(yText,"\\s+")[[1]]))
if ( any(is.na(y)) | length(y) < 2 ) {
y=c(-12.3, 45.6, 78.9) # arbitrary replacement values
updateTextAreaInput( session ,
inputId="dataText" ,
value=paste(as.character(y),collapse=" ") )
}
return( y )
})
# Computation on data for using in slider update:
upUI <- reactive({
low = min( theData() )
val = median( theData() )
high = max( theData() )
return( list( low=low , val=val , high=high ) )
})
# Update slider based on data values:
observe({
updateSliderInput( session , inputId="slider1" ,
min=upUI()$low ,
max=upUI()$high ,
value=upUI()$val )
})
# Debounce the slider value so it doesn't instantly trigger a cascade of long
# computations
sliderValue <- reactive({
return( input$slider1 )
}) %>% debounce(debounceDelay)
# Compute output:
output$theOutput <- renderText({
Sys.sleep(3) # simulate lengthy computation time
return( paste( "Time-consuming computation...
Mean of data plus slider value: " ,
mean(theData()) + sliderValue() ) )
}) # end of renderText
} # end server
shinyApp(ui = ui, server = server)
对@ismirsehregal回复的初始版本的修订：
使用保护eventReactive( input$runComp , { ...long computation... } )进行长时间计算的建议，我修改了初始脚本。不再需要debounce滑块值，因为长时间的计算不会由滑块触发。据我所知，也不需要req(theData(), sliderValue())。我还在计算部分添加了if(){}else{}，以检查是否有无效的文本数据输入。修改后的脚本构成了解决该问题的一种方法。
library(shiny)
ui <- fluidPage(
titlePanel("Data affect Slider, both affect Subsequent Long Computation"),
sidebarLayout(
sidebarPanel(
# Data input:
textAreaInput( inputId="dataText" ,
label=HTML( "<b>Type data here.</b> <small>(Must be at least two numeric values separated by whitespace.)</small>" ) ,
value="10 20 30 40" ,
width="200px" ,
height="100px" ) ,
# Slider input, to be updated by data:
sliderInput( inputId = "slider1" ,
label = HTML("<b>Select constant to add to mean of data.</b> <small>(Slider settings will change if data change.)</small>") ,
min=NA , max=NA , value=NA ,
round=FALSE , step=1 , ticks=FALSE ),
HTML("<p>Click the button to start the time-consuming computation:") ,
actionButton( inputId="runComp" ,
label="Start Computation" )
) , # end sidebarPanel
mainPanel(
textOutput("theOutput")
)
) # end sidebarLayout
) # end ui fluidPage
server <- function(input, output, session) {
theDataDefault = c(-1, 1)
# Parse data values out of data text:
theData = reactive({
yText = input$dataText
y = as.numeric(unlist(strsplit(yText,"\\s+")[[1]]))
return( y )
})
# Computation on data for using in slider update:
upUI <- reactive({
if ( any(is.na(theData())) | length(theData()) < 2 ) {
y = theDataDefault
} else {
y = theData()
}
low = min( y )
val = mean( range( y ) )
high = max( y )
return( list( low=low , val=val , high=high ) )
})
# Update slider based on data values:
observe({
updateSliderInput( session , inputId="slider1" ,
min=upUI()$low ,
max=upUI()$high ,
value=upUI()$val )
})
# Compute output:
textOut <- eventReactive( input$runComp, {
if ( any(is.na(theData())) | length(theData()) < 2 ) {
return( "ERROR: Data must be at least two numeric values (no letters) separated by whitespace (no commas, etc.)." )
} else {
Sys.sleep(3) # simulate lengthy computation time
return( paste( "Time-consuming computation...
Mean of data plus slider value: " ,
mean( theData()) + input$slider1 ) )
}
})
output$theOutput <- renderText({
textOut()
})
} # end server
shinyApp(ui = ui, server = server)
答案 0 :(得分：3)
请检查是否符合您的期望：
现在，滑块的初始值为$navbar-background-color: #f0f0f0;
$another-bulma-variable: 14px;
@import './another-style-variables.scss';
@import '../node_modules/bulma/bulma.sass'; // must be the last thing in file
，因此您可以通过NA阻止初始显示。此外，我在req()中隔离了theData()，以避免它被蜂鸣两次触发（仅侦听滑块的更改）。
renderText编辑：这是一个（基于时间的）解决方案，可以解决@ JohnK.Kruschke所描述的预期行为。我个人更喜欢上面的解决方案（如果主机因外部环境而变慢，但是在我的测试过程中仍然可以工作，则该解决方案可能会失败。）
library(shiny)
library(magrittr) # for pipe operator, %>%, used with debounce().
debounceDelay = 2000 # milliseconds
ui <- fluidPage(
titlePanel("Data affect Slider, both affect Subsequent Long Computation"),
sidebarLayout(
sidebarPanel(
# Data input:
textAreaInput( inputId="dataText" ,
label="Adapt slider data:" ,
value="10 20 30 40" ,
width="200px" ,
height="100px" ) ,
# Slider input, to be updated by data:
sliderInput( inputId = "slider1" ,
label = HTML("Constant to Add to Mean of Data
(after debounce delay):") ,
min=NA , max=NA , value=NA ,
round=FALSE , step=1 , ticks=FALSE ),
actionButton( inputId="runComp" ,
label="Start Computation" )
) , # end sidebarPanel
mainPanel(
textOutput("theOutput")
)
) # end sidebarLayout
) # end ui fluidPage
server <- function(input, output, session) {
# Parse data values out of data text:
theData = reactive({
yText = input$dataText
y = as.numeric(unlist(strsplit(yText,"\\s+")[[1]]))
if ( any(is.na(y)) | length(y) < 2 ) {
y=c(-12.3, 45.6, 78.9) # arbitrary replacement values
updateTextAreaInput( session ,
inputId="dataText" ,
value=paste(as.character(y),collapse=" ") )
}
return( y )
})
# Computation on data for using in slider update:
upUI <- reactive({
low = min( theData() )
val = median( theData() )
high = max( theData() )
return( list( low=low , val=val , high=high ) )
})
# Update slider based on data values:
observe({
updateSliderInput( session , inputId="slider1" ,
min=upUI()$low ,
max=upUI()$high ,
value=upUI()$val )
})
# Debounce the slider value so it doesn't instantly trigger a cascade of long
# computations
sliderValue <- reactive({
return( input$slider1 )
}) %>% debounce(debounceDelay)
# Compute output:
textOut <- eventReactive(input$runComp, {
req(theData(), sliderValue())
Sys.sleep(3) # simulate lengthy computation time
print(paste(Sys.time(), "Time-consuming computation..."))
return( paste( "Time-consuming computation...
Mean of data plus slider value: " ,
mean(theData()) + sliderValue() ) )
})
output$theOutput <- renderText({
textOut()
}) # end of renderText
} # end server
shinyApp(ui = ui, server = server)