RShiny: modify numericInput based on data

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