rshiny

How can I force a shiny app to switch colors after a specific time?


I want to build a shiny app where I can set a time for green (x seconds) and for red (y seconds). After pressing "Start" I want that the traffic light stays green for x seconds and then switch to red for y seconds and then again green for x seconds and so on (until i change the settings, i.e. x and y, and press "Start" again). I created a shiny Code in R, but it doesn't switch as planned. Any ideas?

library(shiny)

ui <- fluidPage(
  titlePanel("Ampelsteuerung"),
  sidebarLayout(
    sidebarPanel(
      numericInput("green_time", "Dauer der Grünphase (Sekunden):", value = 5, min = 1),
      numericInput("red_time", "Dauer der Rotphase (Sekunden):", value = 5, min = 1),
      actionButton("start", "Starten")
    ),
    mainPanel(
      tags$div(
        id = "traffic_light",
        style = "width: 100px; height: 200px; border-radius: 10px; background-color: green;"
      )
    )
  )
)

server <- function(input, output, session) {
  current_color <- reactiveVal("green")
  active <- reactiveVal(FALSE)
  
  observeEvent(input$start, {
    active(TRUE)
  })
  
  observe({
    req(active())
    
    new_color <- ifelse(current_color() == "green", "red", "green")
    current_color(new_color)
    
    update_css <- paste("document.getElementById('traffic_light').style.backgroundColor = '", new_color, "';", sep = "")
    session$sendCustomMessage(type = "jsCode", list(code = update_css))
    
    invalidateLater(ifelse(new_color == "green", input$green_time, input$red_time) * 1000, session)
  })
}

shinyApp(ui = ui, server = server)


Solution

  • My recommendation is to encapsulate the light changing process in javascript and leave the starting and stopping on the R side.

    library(shiny)
    
    ui <- fluidPage(
      tags$head(
        tags$script("
          let myTimeout;
        
          function changeBackgroundColor(color1, interval1, color2, interval2, elementId) {
            let isColor1 = true;
            
            function updateColor() {
              const element = document.getElementById(elementId);
              
              element.style.backgroundColor = isColor1 ? color1 : color2;
              isColor1 = !isColor1;
              
              myTimeout = setTimeout(updateColor, isColor1 ? interval2 : interval1);
            }
    
            clearTimeout(myTimeout);
            
            updateColor();
          };
        
          Shiny.addCustomMessageHandler('runLight', function(x) {
            changeBackgroundColor(x.color1, x.interval1, x.color2, x.interval2, x.element);
          });
        ")
      ),
      sidebarLayout(
        sidebarPanel(
          numericInput("green_time", "Dauer der Grünphase (Sekunden):", value = 1, min = 1),
          numericInput("red_time", "Dauer der Rotphase (Sekunden):", value = 2, min = 1),
          actionButton("start", "Starten")
        ),
        mainPanel(
          tags$div(
            id = "traffic_light",
            style = "width: 100px; height: 200px; border-radius: 10px; background-color: green;"
          )
        )
      )
    )
    
    server <- function(input, output, session) {
      observeEvent(input$start, {
        msg <- list(
          color1 = "green", 
          interval1 = 1000 * input$green_time, 
          color2 = "red", 
          interval2 = 1000 * input$red_time, 
          element = "traffic_light"
        )
        
        session$sendCustomMessage("runLight", msg)
      })
    }
    
    shinyApp(ui, server)
    

    enter image description here

    Reprex files hosted with on GitHub