RShiny: modify numericInput based on data - r

Question

Here's a sample code where I generate random vector and plot its histogram. In addition, there's a numericInput field that I use to clip data, i.e. to assign values lower than a threshold to that threshold. The initial value of the numericInput field is assigned based on data.
The problem is that when I press the button to generate data, the plot is evaluated twice, which I want to avoid. I emphasise this by adding sleep routine in the plotting function.
It seems to me that I'm updating the numericInput incorrectly. When I simply hard-code initial field value of that field, the issue is gone and the plot is evaluated once.
library(shiny)
ui <- shinyUI(fluidPage(
titlePanel("test data clipping"),
sidebarLayout(
sidebarPanel(
actionButton('inDataGen', 'Generate dataset'),
br(),
br(),
uiOutput('resetable_input_clip'),
actionButton('inDataClipReset', 'Reset data clipping')
),
mainPanel(plotOutput("plotHist", width = "100%"))
)
))
server <- shinyServer(function(input, output) {
rValues <- reactiveValues(dataIn = NULL,
dataMin = -10e10)
# generate random dataset
userDataGen <- observeEvent(input$inDataGen, {
cat(file = stderr(), '\nuserDataGen\n')
# assign result to shared 'dataIn' variable
x <- rnorm(1000)
rValues$dataIn = x
rValues$dataMin = min(x)
})
# modify data
userDataProc <- reactive({
cat(file = stderr(), 'userDataProc\n')
dm = rValues$dataIn
if (is.null(rValues$dataIn))
return(NULL)
else {
# Data clipping
dm[dm < input$inDataClipMin] <-
input$inDataClipMin
return(dm)
}
})
output$resetable_input_clip <- renderUI({
cat(file = stderr(), 'output$resetable_input_clip\n')
times <- input$inDataClipReset
div(
id = letters[(times %% length(letters)) + 1],
numericInput(
'inDataClipMin',
'Clip data below threshold:',
value = rValues$dataMin,
width = 200,
step = 100
)
)
})
output$plotHist <- renderPlot({
cat(file = stderr(), 'plotHist \n')
if (is.null(rValues$dataIn))
return(NULL)
else {
plot(hist(userDataProc()))
Sys.sleep(2)
}
})
})
shinyApp(ui = ui, server = server)
The flow after pressing the button to generate data involves two evaluations of plotHist:
output$resetable_input_clip
plotHist
userDataGen
plotHist
userDataProc
output$resetable_input_clip
plotHist
userDataProc
SOLVED ELSWHERE
This issue has been solved on Shiny Google group. The final solution is available here and is a combination of changing observeEvent + reactiveValues to reactive(), and using freezeReactiveValue.

Answer 1

I believe your issue is occurring in
# modify data
userDataProc <- reactive({
cat(file = stderr(), 'userDataProc\n')
dm = rValues$dataIn
if (is.null(df))
return(NULL)
else {
# Data clipping
dm[dm < input$inDataClipMin] <-
input$inDataClipMin
return(dm)
}
})
Since input$inDataClipMin is dependent on the reactive value rValues$dataMin, you end up rendering this for the initial value of rValues$dataMin, the rValues$dataMin is being reevaluated, which triggers a reevaluation of input$inDataClipMin.
If you replace this snippet with what I have below, you should get your desired behavior.
# modify data
userDataProc <- reactive({
cat(file = stderr(), 'userDataProc\n')
dm = rValues$dataIn
if (is.null(df))
return(NULL)
else {
# Data clipping
dm[dm < rValues$dataMin] <-
rValues$dataMin
return(dm)
}
})
As an alternative, you could put the following in your ui
numericInput(
'inDataClipMin',
'Clip data below threshold:',
value = rValues$dataMin,
width = 200,
step = 100
)
And then use updateNumericInput to replace it's value. This would require a lot more tinkering in your current code, however, and depending on what else is happening in your app, may not be the ideal solution anyway.

Answer 2

Here's what I came up with. The key difference is introduction of a shared reactive variable rValues$dataClip that stores clipped data. Previously, data modification was achieved by a reactive function userDataProc. The output of that function was used for plotting which, as suggested by #Benjamin, was the culprit of double evaluation of plotting. In this version, the userDataProc is turned into observeEvent that monitors input$inDataClipMin numeric input field.
library(shiny)
ui <- shinyUI(fluidPage(
titlePanel("test data clipping"),
sidebarLayout(
sidebarPanel(
actionButton('inDataGen', 'Generate dataset'),
br(),
br(),
uiOutput('resetable_input_clip'),
actionButton('inDataClipReset', 'Reset data clipping')
),
mainPanel(plotOutput("plotHist", width = "100%"))
)
))
server <- shinyServer(function(input, output, session) {
rValues <- reactiveValues(dataIn = NULL,
dataClip = NULL,
dataMin = -10e10)
# generate random dataset
userDataGen <- observeEvent(input$inDataGen, {
cat(file = stderr(), '\nuserDataGen\n')
# assign result to shared 'dataIn' variable
x <- rnorm(1000)
rValues$dataIn = x
rValues$dataMin = min(x)
})
# modify data
userDataProc <- observeEvent(input$inDataClipMin, {
cat(file = stderr(), 'userDataProc\n')
dm = rValues$dataIn
if (is.null(rValues$dataIn))
rValues$dataClip = NULL
else {
dm[dm < input$inDataClipMin] <-
input$inDataClipMin
rValues$dataClip <- dm
}
})
output$resetable_input_clip <- renderUI({
cat(file = stderr(), 'output$resetable_input_clip\n')
times <- input$inDataClipReset
div(
id = letters[(times %% length(letters)) + 1],
numericInput(
'inDataClipMin',
'Clip data below threshold:',
value = rValues$dataMin,
width = 200,
step = 100
)
)
})
output$plotHist <- renderPlot({
cat(file = stderr(), 'plotHist \n')
if (is.null(rValues$dataClip))
return(NULL)
else {
plot(hist(rValues$dataClip))
Sys.sleep(2)
}
})
})
shinyApp(ui = ui, server = server)
Now, there's only one evaluation of plotHist after pressing the button to generate data:
output$resetable_input_clip
plotHist
userDataProc
userDataGen
output$resetable_input_clip
userDataProc
plotHist