Flash redraw

fixFlash.R

# Joe Cheng provided this code

library(shiny)
#' Call `input <- createInputWrapper(input)` at the top of
#' your Shiny Server function.
createInputWrapper <- function(input) {
  env <- new.env(parent = emptyenv())
  env$impl <- input
  env$blacklist <- new.env(parent = emptyenv())
  
  structure(
    env,
    class = "inputWrapper"
  )
}

`$.inputWrapper` <- function(x, name) {
  realInput <- base::get("impl", x)
  result <- realInput[[name]]
  
  if (isTRUE(base::get("blacklist", x)[[name]])) {
    req(FALSE)
  }
  
  result
}

`[[.inputwrapper` <- `$.inputWrapper`

#' Invalidate an input value, that is, mark it so that any future
#' attempts to read the value will result in a silent error being
#' thrown (equivalent to `req(FALSE)`). The value will exit the
#' invalidated state automatically the next time the client sends
#' a new value; or manually, with a call to restoreInput().
invalidateInput <- function(input, name) {
  force(input)
  force(name)
  
  firstRun <- TRUE
  o <- observe({
    getDefaultReactiveDomain()$input[[name]]
    if (firstRun) {
      firstRun <<- FALSE
    } else {
      o$destroy()
      restoreInput(input, name)
    }
  }, priority = 999999)
  
  base::assign(name, TRUE, base::get("blacklist", input))
}

#' Make an input value available for reading again.
restoreInput <- function(input, name) {
  cat("Restore ", name, "\n")
  base::rm(list = name, envir = base::get("blacklist", input))
}

server <- function(input, output, session) {
  
  input <- createInputWrapper(input)
  output$plot <- renderPlot({
    
    h <- input$height
    w <- input$width

        plot(1:10, main=paste(input$title, sample(1:100,1), type=input$type))
        rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = sample(colors() ,1))


  })
  
  observe({
    updateNumericInput(session, "width", value = input$height)
    invalidateInput(input, "width")
  })
  
  observe({
    updateNumericInput(session, "title", value = paste("Width is", input$width))
    invalidateInput(input, "title")
  })
  
} 

ui <- fluidPage(
  
  tags$div(class="panel-body",

           numericInput("height", "height", 300),
           textInput("title", "Give a title",  "This is my initital title"),
           numericInput("width", "width", 300),
           selectInput("type", "choose type", choices=c("p", "n", "s"), selected="s")
           
  ),
  
  plotOutput("plot")
  
  
)

shinyApp(ui = ui, server = server)

noflash.R

library(shiny)
server <- function(input, output, session) {
  
  #input <- createInputWrapper(input)
  output$plot <- renderUI({
    
    h <- input$height
    w <- input$width
    list(
      tags$h3("Plot information"),
      renderPlot({
        plot(1:10, main=paste(input$title, sample(1:100,1), type=input$type))
        rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = sample(colors() ,1))

      })
    )
  })
  
  observe({
    updateNumericInput(session, "width", value = input$height)
  })
  
  observe({
    updateNumericInput(session, "title", value = paste("Width is", input$width))
  })
  
} 

ui <- fluidPage(
  
  tags$div(class="panel-body",
           numericInput("height", "height", 300),
           textInput("title", "Give a title",  "This is my initital title"),
           numericInput("width", "width", 300),
           selectInput("type", "choose type", choices=c("p", "n", "s"), selected="s")
           
  ),
  
  uiOutput("plot")
  
  
)

shinyApp(ui = ui, server = server)

yesFlash.R

library(shiny)
server <- function(input, output, session) {
  output$plot <- renderPlot({
    
    h <- input$height
    w <- input$width

        plot(1:10, main=paste(input$title, sample(1:100,1), type=input$type))
        rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = sample(colors() ,1))


  })
  
  observe({
    updateNumericInput(session, "width", value = input$height)
  })
  
  observe({
    updateNumericInput(session, "title", value = paste("Width is", input$width))
  })
  
} 

ui <- fluidPage(
  
  tags$div(class="panel-body",

           numericInput("height", "height", 300),
           textInput("title", "Give a title",  "This is my initital title"),
           numericInput("width", "width", 300),
           selectInput("type", "choose type", choices=c("p", "n", "s"), selected="s")
           
  ),
  
  plotOutput("plot")
  
  
)

shinyApp(ui = ui, server = server)