Search code examples
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
    1. sendCustomMessage does not directly execute JavaScript code on the client. Instead, it sends a message that a JavaScript handler needs to process. -> Use shinyjs::runjs
    2. invalidateLater does not what you expect. If you use a reactive element inside the observer it will retrigger itself. So I would just calculate the ellapsed time every second and check against the input timers. The Start time is reset once any of the two timers is hit.

    out

    In this solution you can click "Start" once and update the two timers in realtime.

    library(shiny)
library(shinyjs)  # Load shinyjs

ui <- fluidPage(
  useShinyjs(),  # Enable JavaScript execution
  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)
  start_time <- reactiveVal(Sys.time())
  
  autoInvalidate <- reactiveTimer(1000) # we run the observer every second
  
  observeEvent(input$start, {
    active(TRUE)  # Start the traffic light system
    start_time(Sys.time())  # Reset the start time
  })
  
  observe({
    if (active()) {
      autoInvalidate()  # Re-run this observer every second
      
      elapsed_time <- as.numeric(difftime(Sys.time(), start_time(), units = "secs"))
      
      if (current_color() == "green" && elapsed_time >= input$green_time) {
        current_color("red")
        start_time(Sys.time())  # Reset the start time for the red phase
      } else if (current_color() == "red" && elapsed_time >= input$red_time) {
        current_color("green")
        start_time(Sys.time())  # Reset the start time for the green phase
      }
      
      # Update the traffic light color in the UI using proper js call
      runjs(sprintf('document.getElementById("traffic_light").style.backgroundColor = "%s";', current_color()))
    }
  })
}

shinyApp(ui = ui, server = server)