Shinylive in Quarto - Dynamic Palette Demo

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

theme <- bs_theme(font_scale = 1.5)

# Define UI for app that draws a histogram ----
ui <- page_sidebar(theme = theme,
  sidebar = sidebar(open = "open",
    numericInput("n", "Sample count", 100),
    checkboxInput("pause", "Pause", FALSE),
    selectInput("col_pal", "Select desired palette:", choices = palette.pals(), selected = "R4")
  ),
  
  plotOutput("plot", width=1000),
)

server <- function(input, output, session) {
  data <- reactive({
    input$resample
    if (!isTRUE(input$pause)) {
      invalidateLater(1000)
    }
    rnorm(input$n)
  })

  
  output$plot <- renderPlot({
    hist(data(),
      breaks = 40,
      xlim = c(-2, 2),
      ylim = c(0, 1),
      lty = "blank",
      xlab = "value",
      freq = FALSE,
      main = ""
    )
    
    n_col <- 4 #hard-coded
  plot_colors = palette.colors(n_col, palette = input$col_pal)

    
    x <- seq(from = -2, to = 2, length.out = 500)
    y <- dnorm(x)
    lines(x, y, lwd=1.5, col = plot_colors[1]) 
    
    
    lwd <- 5
    abline(v=0, col=plot_colors[2], lwd=lwd, lty=2) 
    abline(v=mean(data()), col=plot_colors[3], lwd=lwd, lty=1) 

    legend(legend = c("Normal", "Mean", "Sample mean"),
      col = plot_colors,
      lty = c(1, 2, 1),
      lwd = c(1, lwd, lwd),
      x = 0.7,
      y = 0.9
    )
  }, res=140)

}

# Create Shiny app ----
shinyApp(ui = ui, server = server)