Update Plot Within Observer Loop in Shiny Application

R Shiny: Adding to plot via a loop

You can use reactiveTimer to do that. I have modified the server part of your code. In the code below I have set the timer for two seconds so that the plot updates every two seconds.

  server <- function(input, output) {

    autoInvalidate <- reactiveTimer(2000)
    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")
      plot1
    })

    observeEvent(input$button,{

      output$plot1 <- renderPlot({
        autoInvalidate()
        data$sampled <- "red"
        sample.rows <- sample(data$ID, 20, replace = F)
        data$sampled[sample.rows] <- "green"

        plot1 <<- plot1 + geom_point(x=data$x, y=data$y, colour=data$sampled, size=2)

        sample.mean.x <- mean(data$x[sample.rows])

        plot1 <<- plot1 + geom_vline(xintercept = sample.mean.x, colour="green")

        plot1

      })
    })
  }

[EDIT]:

As you wanted the loop to be run only 20 times I have modified the code with the help of the answer in this link so that the reactive timer is run only till the count is 20. Here is the code that you need to add from the link:

  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")

Here is the server code for it:

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

count = 0
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")
    plot1
  })

observeEvent(input$button,{
 count <<- 0
  output$plot1 <- renderPlot({

    count <<- count+1
    invalidateLater(1500, session,  count < 20)
    data$sampled <- "red"
    sample.rows <- sample(data$ID, 20, replace = F)
    data$sampled[sample.rows] <- "green"

    plot1 <<- plot1 + geom_point(x=data$x, y=data$y, colour=data$sampled, size=2)

    sample.mean.x <- mean(data$x[sample.rows])

    plot1 <<- plot1 + geom_vline(xintercept = sample.mean.x, colour="green")

    plot1

  })
})

 }

Force shiny to render plot in loop

You could nest an observer into an observeEvent to make it work. Based on Jeff Allen's code from the SO topic you linked.

Crucial part:

observeEvent(input$run, {
    rv$i <- 0
    observe({
      isolate({
        rv$i <- rv$i + 1
      })

      if (isolate(rv$i) < maxIter){
        invalidateLater(2000, session)
      }
    })
  })

Full code:

library(shiny)

server <- function(input, output, session) {
  rv <- reactiveValues(i = 0)
  maxIter <- 3

  output$myplot <- renderPlot( {
    if(rv$i > 0) {
      x <- seq_len(rv$i * 100)
      y <- (x + 1)^2 - 1 # this will do for now
      plot(x, y, main = sprintf("Round %i", rv$i), type = "l") 
    } else {
      plot(1:1, main = "Placeholder")
    }
  })

  observeEvent(input$run, {
    rv$i <- 0
    observe({
      isolate({
        rv$i <- rv$i + 1
      })

      if (isolate(rv$i) < maxIter){
        invalidateLater(2000, session)
      }
    })
  })

}

ui <- fluidPage(
  actionButton("run", "START"),
  plotOutput("myplot")
)

shinyApp(ui = ui, server = server)

update goes into a loop shiny

this should work:

library(shiny)

ymax <- 100
ymin <- 0

ui <- fluidPage(
  sidebarPanel(

    h3("See"),

    numericInput("yinter", "Vertical interval (m)",
                 min = 0, max = ymax, value = 50, step = 0.5),

    numericInput("movepercent", "Scroll interval (%)",
                 min = 0, max = 100, value = 15, step = 5),

    uiOutput("inputs"),

    actionButton("up","",icon("arrow-up"),
                 width = "100%"),

    actionButton("down","",icon("arrow-down"),
                 width = "100%",""),

    width=2
  ),

  sidebarPanel(
    plotOutput("plot1",height = 800)
  )

)

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

  ival <- reactiveVal(0)

  observeEvent(input$up, {
    newval <- ival() + input$yinter*(input$movepercent/100)
    ival(newval)
  })

  observeEvent(input$down, {
    newval <- ival() - input$yinter*(input$movepercent/100)
    ival(newval)
  })

  observeEvent(input$heightSlider, {
  if(input$heightNumeric != input$heightSlider){
    ival(input$heightSlider)
  }
  })

  observeEvent(input$heightNumeric, {
  if(input$heightNumeric != input$heightSlider){
    ival(input$heightNumeric)
  }
  })

  output$inputs <- renderUI({
    newval <- ival()
    tagList(
      numericInput("heightNumeric", "Height (m)",
                   min = ymin, max = ymax, value = newval, step = 1),

      sliderInput("heightSlider","Height (m)",min = ymin, max = ymax, 
                  value = newval ,step=0.01)

    )
  })

  output$plot1 <- renderPlot({
    plot(seq(from=0,to=1,by=0.0001),seq(from=0,to=100,by=0.01),
         type="l",ylim=c(ival() - input$yinter/2,
                         ival() + input$yinter/2))
  })
}

shinyApp(ui = ui, server = server)

Plotting graphs in Shiny R; using a repeat loop to plot data for automated analysis

You should take a look at the invalidateLater or reactiveTimer functions.

I'm using invalidateLater in the following example (NOTE: the function takes milliseconds as first argument).

You also shouldn't put any outputs inside an observer, make a reactiveVal / reactiveValues object and fill that at every new interval. You can use that object anywhere in the app then.

I also changed the observeEvent to a normal observe, since otherwise it would only trigger when the Button is clicked. Now, the observer triggers, when the Button is clicked, the interval slider is changed and when the interval has passed.

library(shiny)
library(ggplot2)
ui<-fluidPage(
  titlePanel('Minimal example'),
  tabsetPanel(
    tabPanel("Example",
             sidebarPanel(width = 4, 
                          h5("The default interval for the analysis refresh is 5 minutes. If you wish to change this, please do so in the box below:"),
                          numericInput("intervaltime","Input refresh interval:",5),
                          br(),
                          h5("Press 'Run Analysis' button below to start automated analysis"),
                          actionButton("automatedanalysis", "Run Analysis")),
             mainPanel(
               h4("An example plot"),
               plotOutput("example_plot", width = "100%"),
               h4("Some text with updated system time"),
               textOutput("example_text")
             )
    )))

server<-function(input,output,session){
  rv <- reactiveVal(NULL)
  observe({
    interval = input$intervaltime*1000
    invalidateLater(interval, session)
    req(input$automatedanalysis)
    print("Fill ReactiveVal")
    mpg$hwy <- mpg$hwy * runif(nrow(mpg))
    rv(mpg)
  })
  output$example_plot<-renderPlot({
    req(rv())
    currenttime<-Sys.time()
    print("Plot Code")
    ggplot(rv(), aes(displ, hwy, colour = class)) + 
      geom_point()+ggtitle(paste0("graph made at: ",currenttime))
  })
  output$example_text<-renderText({
    print(paste0("The current system time is: ", Sys.time())) #a check to know that it is working
  })
}

shinyApp(ui, server)

R Shiny: how to prevent duplicate plot update with nested selectors?

You can use isolateto avoid dependency of your histogram on input$category:

  output$histogram <- renderPlot({
    cat(paste("hist:", "category =", isolate(input$category),
              "value =",input$value, "\n"), file = stderr())
    hist(data[data[, isolate(input$category)] == input$value, "height"])
  })

Your histogram will no longer be updated when the category changes. Changing the category also changes the value in your app, and the histogram will update when that value is changed.

More info on isolate here.

Shiny app ploting every few seconds after button press

Well, I guess I'm an Idiot and I found a similar problem discussed here (ofcourse 30 minutes after posting this) and I was able to adapt the code. Hope this helps someone in the future.

library(shiny)

ui <- fluidPage(
  shinyjs::useShinyjs(),
  tags$style(type="text/css",
             ".recalculating {opacity: 1.0;}"),
      mainPanel(
        actionButton("Start","START", width='100%'),
        plotOutput("A")
      )
   )

server <- function(input, output, session) {
  par(bg = 'black')
  maxIter <- 5
  vals <- reactiveValues( A = matrix(nrow=5,ncol =5,sample(3,size =25,replace=T)),counter = 1)
  observeEvent(input$Start, {
    vals$counter <- 1 
    shinyjs::disable("Start")
    output$A <- renderPlot({
       Sys.sleep(0.5)
       image(vals$A,xaxt='n', ann=FALSE,yaxt='n',bty="n",asp=1)

       })

  })

     observeEvent(input$Start, {
                                observe({
                                        isolate({
                                              vals$A <- matrix(nrow=5,ncol =5,sample(3,size =25,replace=T))
                                              vals$counter <- vals$counter + 1 #for loop

                                              })

                                        if (isolate(vals$counter) <= maxIter) 
                                                invalidateLater(0, session)
                                        })
                                  })
     observe({vals$counter
       if (vals$counter > maxIter)
         shinyjs::enable("Start")
       })
}
shinyApp(ui = ui, server = server)

---

Related Topics