← Back to the journal

JOURNAL / 2026-09-11

Sidebar Shiny app

This is an example of a Shiny app with a sidebar layout.

This is an example of a Shiny app with a sidebar layout

library(shiny)

cars_data <- data.frame(model = rownames(mtcars), mtcars, row.names = NULL)
variable_labels <- c(
  "Fuel economy (mpg)" = "mpg", "Weight (1,000 lbs)" = "wt",
  "Horsepower" = "hp", "Displacement (cu. in.)" = "disp",
  "Quarter-mile time (seconds)" = "qsec"
)

ui <- fluidPage(
  tags$head(tags$style(HTML("
    body { background: #f5f7fb; color: #192b41; }
    .container-fluid { max-width: 1400px; padding: 24px; }
    h2 { font-weight: 700; }
    .well { background: white; border: 1px solid #dfe5ee; border-radius: 12px; }
    .explorer-panel { background: white; padding: 24px; border-radius: 12px;
                      border: 1px solid #dfe5ee; }
    .intro { color: #5d6d80; margin-bottom: 24px; }
    .summary { background: #eef4ff; padding: 16px; border-radius: 8px;
               margin-bottom: 20px; font-size: 16px; }
    .nav-tabs { margin-bottom: 20px; }
  "))),
  titlePanel("Motor lab"),
  p(class = "intro", "Explore fuel economy and performance across 32 cars from the built-in mtcars dataset."),
  sidebarLayout(
    sidebarPanel(
      h4("Filter the dataset"),
      checkboxGroupInput("cylinders", "Cylinders", choices = c(4, 6, 8), selected = c(4, 6, 8)),
      selectInput("transmission", "Transmission", c("All" = "all", "Automatic" = "0", "Manual" = "1")),
      sliderInput("mpg_range", "Fuel economy (mpg)",
                  min = min(cars_data$mpg), max = max(cars_data$mpg),
                  value = range(cars_data$mpg), step = 0.1),
      hr(),
      downloadButton("download", "Download filtered CSV"),
      width = 3
    ),
    mainPanel(
      div(class = "explorer-panel",
        uiOutput("summary"),
        tabsetPanel(
          tabPanel("Explore",
            fluidRow(
              column(4, selectInput("x", "Horizontal axis", variable_labels, selected = "wt")),
              column(4, selectInput("y", "Vertical axis", variable_labels, selected = "mpg")),
              column(4, sliderInput("point_size", "Point size", min = 1, max = 4, value = 2, step = 0.25))
            ),
            checkboxInput("trend", "Show linear trend", value = TRUE),
            plotOutput("scatter", height = "420px"),
            p(class = "intro", "Colors indicate cylinder count. The dashed line shows a linear fit across the filtered cars.")
          ),
          tabPanel("Data", tableOutput("data_table"))
        )
      ),
      width = 9
    )
  )
)

server <- function(input, output, session) {
  filtered_data <- reactive({
    req(input$mpg_range, input$transmission)
    selected <- cars_data$cyl %in% as.numeric(input$cylinders) &
      cars_data$mpg >= input$mpg_range[1] & cars_data$mpg <= input$mpg_range[2]
    if (input$transmission != "all") {
      selected <- selected & cars_data$am == as.numeric(input$transmission)
    }
    cars_data[selected, , drop = FALSE]
  })

  output$summary <- renderUI({
    data <- filtered_data()
    if (!nrow(data)) {
      return(div(class = "summary", role = "status", "No cars match. Adjust the sidebar filters to see results."))
    }
    div(class = "summary", role = "status",
        strong(sprintf("%d of %d cars", nrow(data), nrow(cars_data))),
        sprintf(" · Average economy: %.1f mpg · Average power: %.0f hp", mean(data$mpg), mean(data$hp)))
  })

  output$scatter <- renderPlot({
    data <- filtered_data()
    validate(need(nrow(data) > 0, "No cars match the current filters."))
    req(input$x, input$y, input$point_size)
    palette <- c("4" = "#2563eb", "6" = "#b45309", "8" = "#0f766e")
    par(mar = c(5, 5, 2, 1), fg = "#5d6d80", col.axis = "#5d6d80", col.lab = "#192b41")
    plot(data[[input$x]], data[[input$y]],
         xlab = names(variable_labels)[match(input$x, variable_labels)],
         ylab = names(variable_labels)[match(input$y, variable_labels)],
         type = "n", bty = "l")
    grid(col = "#e8edf4")
    points(data[[input$x]], data[[input$y]], pch = 21,
           bg = palette[as.character(data$cyl)], col = "white", cex = input$point_size)
    if (isTRUE(input$trend) && nrow(data) >= 2 && length(unique(data[[input$x]])) > 1) {
      fit <- lm(data[[input$y]] ~ data[[input$x]])
      abline(fit, col = "#334155", lwd = 2, lty = 2)
    }
    present <- sort(unique(data$cyl))
    legend("topright", legend = paste(present, "cylinders"),
           pt.bg = palette[as.character(present)], col = "white", pch = 21,
           pt.cex = 1.5, bty = "n", text.col = "#192b41")
  }, res = 110)

  output$data_table <- renderTable({
    data <- filtered_data()
    validate(need(nrow(data) > 0, "No cars match the current filters."))
    data.frame(Model = data$model, MPG = data$mpg, Cylinders = data$cyl,
               Horsepower = data$hp, `Weight (1,000 lbs)` = data$wt,
               Transmission = ifelse(data$am == 1, "Manual", "Automatic"),
               check.names = FALSE)
  }, striped = TRUE, bordered = FALSE, spacing = "m")

  output$download <- downloadHandler(
    filename = function() paste0("motor-lab-", Sys.Date(), ".csv"),
    content = function(file) write.csv(filtered_data(), file, row.names = FALSE)
  )
}

shinyApp(ui, server)

LET’S STAY IN TOUCH

Ideas in your inbox.

New stories, discoveries, and a little code. Subscribe to the Blinky Now newsletter.