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)
✳