Reset renderPlot

Published onesixx on 20-02-1420-02-14

library(shiny)
# UI @@@@@@---------------------------------------------------------------------
ui <- fluidPage(
  sidebarPanel(
    sliderInput(inputId="slide_sampleNum", "Number of samples:", min=10, max=nrow(data), value=20),
    actionButton(inputId="btn_go", "Go!"),
    actionButton(inputId="btn_reset", "Reset"), br(),br(),
    sliderInput(inputId="slide_pntSize", "size of point:", min=1, max=10, value=2),
  ),
  mainPanel(
    plotOutput(outputId="plot_samplePlot")
  )
)
# SERVER @@@@@@-----------------------------------------------------------------
server <- function(input, output, session){
  observeEvent(input$btn_go,{
    cat("1.buttonGo!--------------------------------------------------------\n")
    rct_loadData()
  })
  
  rct_loadData <- reactive({
    req(input$btn_go)
    cat("2.rct_loadData!----------------------------------------------------\n")
    rct_resetData(FALSE)
    sampleNum <- isolate(input$slide_sampleNum)
    data <- data.table(ID=1:sampleNum, 
                       x=sort(runif(n=sampleNum)), 
                       y=sort(runif(n=sampleNum) + rnorm(sampleNum)))
    return(data)
  })
  
  rct_resetData <- reactiveVal(TRUE)
  
  output$plot_samplePlot <- renderPlot({
    cat("3.plot_samplePlot!-------------------------------------------------\n")
    data = tryCatch({
      rct_loadData()
    }, error=function(e){
      NULL
    })     
    if(!rct_resetData() && !is.null(data)){
      p <- data %>% ggplot(aes(x,y)) + geom_point(size=input$slide_pntSize)
      return(p)
    }else{
      msg=str_c("\n Oh My God !... ",
                "\n Not enough data !! ")
      p <- ggplot() + annotate("text", x=6, y=36, size=6, label=msg) +
             theme_ipsum()+ labs(x="", y="")+
             theme(panel.grid = element_blank(),
                   axis.text  = element_blank())
      return(p)
    }
  })
  # solve ------
  observeEvent(input$btn_reset,{
    cat("0.buttonReset!-----------------------------------------------------\n")
    rct_resetData(TRUE)
  })
}
shinyApp(ui, server)

Inspired by https://stackoverflow.com/questions/43383010/r-shiny-reset-plot-to-default-state

library(shiny)

invalidateLaterNew <- function(millis, session=getDefaultReactiveDomain(), update=TRUE){
  if(update){
    ctx <- shiny:::.getReactiveEnvironment()$currentContext()
    shiny:::timerCallbacks$schedule(millis, function() {
      if (!is.null(session) && session$isClosed()) {
        return(invisible())
      }
      ctx$invalidate()
    })
    invisible()
  }
}
unlockBinding("invalidateLater", as.environment("package:shiny"))
assign("invalidateLater", invalidateLaterNew, "package:shiny")

# UI @@@@@@---------------------------------------------------------------------
ui <- fluidPage(
  sidebarPanel(
    sliderInput(inputId="slide_sampleNum", "Number of samples:", min=10, max=nrow(data), value=20),
    sliderInput(inputId="slide_surveys",   "Number of surveys:", min= 1, max=10, value=5),
    actionButton(inputId="btn_go", "Go!"),
    actionButton(inputId="btn_reset", "Reset")
  ),
  mainPanel(
    plotOutput(outputId="plot1")
  )
)
# SERVER @@@@@@-----------------------------------------------------------------
server <- function(input, output, session){
  plot1 <- NULL
  count <- 0
  
  observeEvent(input$btn_go,{
    cat("buttonGo!----------------------------\n")
    count <<- 0
    loadData()
  })
  
  loadData <- reactive({
    cat("loadData!----------------------------\n")
    req(input$btn_go)
    count <<- count+1
    invalidateLater(500, session, count<isolate(input$slide_surveys))
    data$sampled <- "red"
    sample.rows <- sample(data$ID, isolate(input$slide_sampleNum))
    data[ID %in% sample.rows, sampled:="green"] 
    return(data)
  })
  
  output$plot1 <- renderPlot({
    cat("plot1!----------------------------\n")
    tryCatch({
      data = loadData()
      sample.mean.x <- data[sampled=="green", mean(x)]
      plot1 <<- plot1 + geom_point(x=data$x, y=data$y, colour=data$sampled, size=2)
      plot1 <<- plot1 + geom_vline(xintercept = sample.mean.x, colour="green")
      return(plot1)
    }, error=function(e){
      data=data.table(ID=1:60, 
                      x=sort(runif(n=60)), 
                      y=sort(runif(n=60) + rnorm(60)))
      plot1 <<- ggplot(data, aes(x=x, y=y)) + geom_point(color="red") + theme_bw()
      plot1 <<- plot1 + geom_vline(xintercept = mean(data$x), size=1.1, colour="red")
      return(plot1)
    })
  })

  # solve ------
  observeEvent(input$btn_reset,{
    cat("Button Reset!----------------------------\n")
    validate(need(input$btn_go,"do it first before reset !!!"))
    plot1 <<- NULL
    output$plot1 <- renderPlot({
      plot1 <<- ggplot(data, aes(x=x, y=y)) + geom_point(colour="red") + theme_bw()
      plot1 <<- plot1 + geom_vline(xintercept = mean(data$x), size=1.1, colour="red")
      return(plot1)
    })
  })
}
shinyApp(ui, server)

Reset renderPlot

Inspired by https://stackoverflow.com/questions/43383010/r-shiny-reset-plot-to-default-state

onesixx

Shiny

the condition has length > 1 and only the first element will be used

Shiny

Promise

Shiny

Error: invalid quartz() device size

Reset renderPlot

Inspired by https://stackoverflow.com/questions/43383010/r-shiny-reset-plot-to-default-state

onesixx

Related Posts

Shiny

the condition has length > 1 and only the first element will be used

Shiny

Promise

Shiny

Error: invalid quartz() device size