Interactive: Six-sided die roll

Summary

Interactive six-sided die roll for use in the guide on introduction to probability.

#| '!! shinylive warning !!': |
#|   shinylive does not work in self-contained HTML documents.
#|   Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 300
library(shiny)
library(bslib)

# Hard-coded hex color for the button (a nice teal color)
BUTTON_COLOR <- "#3F6BB6"

ui <- page_fluid(
  title = "Six-sided die roller",
  
  card(
    card_header("Six-sided die roller"),
    card_body(
      # Use a row layout for landscape orientation
      layout_columns(
        col_widths = c(4, 4, 4), # Equal width columns
        
        # Left column: Description
        card(
          card_body(
            div(
              style = "display: flex; height: 100%; align-items: center; justify-content: center;",
              p("Click the button to roll a 6-sided die.", style = "font-size: 18px;")
            )
          )
        ),
        
        # Middle column: Dice display
        card(
          card_body(
            div(
              style = "text-align: center;",
              div(
                style = "font-size: 120px; line-height: 1.2; width: 150px; height: 150px; 
                       margin: 0 auto; border: 2px solid #ccc; border-radius: 15px;
                       display: flex; align-items: center; justify-content: center;",
                textOutput("diceValue")
              )
            )
          )
        ),
        
        # Right column: Button
        card(
          card_body(
            div(
              style = "display: flex; height: 100%; align-items: center; justify-content: center;",
              actionButton("rollButton", "Roll Dice", class = "btn-lg", 
                          style = paste0("background-color: ", BUTTON_COLOR, "; color: white;"))
            )
          )
        )
      )
    )
  )
)

server <- function(input, output, session) {
  
  # Create a reactive value to store the current roll
  diceValue <- reactiveVal(sample(1:6, 1))
  
  # Update the dice value when the roll button is clicked
  observeEvent(input$rollButton, {
    # Rolling animation - this is a simplified version using invalidateLater
    # to simulate the dice rolling
    for(i in 1:5) {
      invalidateLater(i * 100)
    }
    
    # Final roll
    diceValue(sample(1:6, 1))
  })
  
  # Display the current dice value
  output$diceValue <- renderText({
    diceValue()
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

Further reading

This interactive element appears in Guide: Introduction to probability. Please click this link to go to the guide.

Version history

v1.0: initial version created 04/25 by Michelle Arnetta (as part of a University of St Andrews VIP project) and tdhc.

This work is licensed under CC BY-NC-SA 4.0.