Reset renderPlot

Published by onesixx on

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!--------------------------------------------------------\
")
    rct_loadData()
  })
  
  rct_loadData <- reactive({
    req(input$btn_go)
    cat("2.rct_loadData!----------------------------------------------------\
")
    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!-------------------------------------------------\
")
    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("\
 Oh My God !... ",
                "\
 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!-----------------------------------------------------\
")
    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!----------------------------\
")
    count <<- 0
    loadData()
  })
  
  loadData <- reactive({
    cat("loadData!----------------------------\
")
    req(input$btn_go)
    count <<- count+1
    invalidateLater(500, session, count 								
Categories: R-Shiny

onesixx

Blog Owner

Subscribe
Notify of
guest

0 Comments
Inline Feedbacks
View all comments
0
Would love your thoughts, please comment.x
()
x