README.md

Ref: https://groups.google.com/d/msgid/shiny-discuss/3c435a73-89a7-4a1e-b77b-e151f23f1fbe%40googlegroups.com?utm_medium=email&utm_source=footer

clipping.R

library(shiny)

ui <- shinyUI(fluidPage(
  titlePanel("test data clipping"),
  
  sidebarLayout(
    sidebarPanel(
      actionButton('inDataGen', 'Generate dataset'),
      br(),
      br(),
      numericInput(
        'inDataClipMin',
        'Clip data below threshold:',
        value = NULL,
        width = 200,
        step = .1
      ),
      numericInput(
        'inDataClipMax',
        'Clip data above threshold:',
        value = NULL,
        width = 200,
        step = .1
      ),
      actionButton('inDataClipReset', 'Reset data clipping')
    ),
    mainPanel(plotOutput("plotHist", width = "100%"))
  )
))

server <- shinyServer(function(input, output, session) {

  # generate random dataset
  dataIn <- eventReactive(input$inDataGen, {
    cat(file = stderr(), '\nuserDataGen\n')
    
    rnorm(1000)
  })
  
  observeEvent(dataIn(), {
    resetClip()
  }, priority = 10)
  
  resetClip <- function() {
    updateNumericInput(session, "inDataClipMin", value = min(dataIn()))
    freezeReactiveValue(input, "inDataClipMin")
    updateNumericInput(session, "inDataClipMax", value = max(dataIn()))
    freezeReactiveValue(input, "inDataClipMax")
  }
  
  observeEvent(input$inDataClipReset, {
    resetClip()
  })
  
  dataClip <- reactive({
    dm <- dataIn()
    dm[dm > input$inDataClipMin & dm < input$inDataClipMax]
  })
  
  output$plotHist <- renderPlot({
    dm = dataClip()
    cat(file = stderr(), 'plotHist \n')
    
    if (is.null(dm))
      return(NULL)
    else {
      plot(hist(dm))
      Sys.sleep(2)
    }
  })
})

shinyApp(ui = ui, server = server)