Data Explorer

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

## file: sample_data.csv
id,age,gender,score,group,reaction_time
1,22,Female,78,Control,342
2,25,Male,85,Treatment,298
3,19,Female,72,Control,367
4,31,Male,91,Treatment,275
5,28,Female,88,Treatment,289
6,24,Male,69,Control,401
7,21,Female,82,Treatment,312
8,27,Male,75,Control,356
9,23,Female,94,Treatment,267
10,26,Male,71,Control,389
11,20,Female,86,Treatment,295
12,29,Male,77,Control,348
13,22,Female,89,Treatment,281
14,25,Male,73,Control,372
15,24,Female,92,Treatment,269
16,30,Male,68,Control,412
17,21,Female,84,Treatment,303
18,28,Male,79,Control,339
19,23,Female,96,Treatment,258
20,26,Male,74,Control,365

## file: app.R
library(shiny)
library(bslib)

# Load the embedded data
data <- read.csv("sample_data.csv")

ui <- page_sidebar(
  title = "Data Explorer",

  sidebar = sidebar(
    width = 300,
    selectInput(
      "x_var",
      "X Variable:",
      choices = names(data),
      selected = "age"
    ),
    selectInput(
      "y_var",
      "Y Variable:",
      choices = names(data),
      selected = "score"
    ),
    selectInput(
      "colour_var",
      "Colour by:",
      choices = c("None", names(data)),
      selected = "group"
    ),
    hr(),
    selectInput(
      "summary_var",
      "Summarise Variable:",
      choices = names(data)[sapply(data, is.numeric)],
      selected = "score"
    ),
    selectInput(
      "group_var",
      "Group by:",
      choices = c("None", names(data)),
      selected = "group"
    ),
    hr(),
    p("This app loads an embedded CSV dataset and lets you explore it interactively.")
  ),

  navset_card_tab(
    nav_panel(
      "Data",
      tableOutput("data_table")
    ),
    nav_panel(
      "Plot",
      plotOutput("scatter_plot", height = "400px")
    ),
    nav_panel(
      "Summary",
      tableOutput("summary_table")
    )
  )
)

server <- function(input, output, session) {

  output$data_table <- renderTable({
    data
  }, striped = TRUE, hover = TRUE, width = "100%")

  output$scatter_plot <- renderPlot({
    x <- data[[input$x_var]]
    y <- data[[input$y_var]]

    # Handle colour
    if (input$colour_var == "None") {
      col <- "#0d6efd"
    } else {
      colour_data <- data[[input$colour_var]]
      if (is.numeric(colour_data)) {
        col <- colorRampPalette(c("#0d6efd", "#dc3545"))(100)[
          cut(colour_data, breaks = 100, labels = FALSE)
        ]
      } else {
        colour_levels <- as.factor(colour_data)
        colours <- c("#0d6efd", "#dc3545", "#198754", "#ffc107", "#6f42c1")
        col <- colours[as.numeric(colour_levels)]
      }
    }

    par(mar = c(5, 5, 3, 2))

    # Determine plot type based on variable types
    x_numeric <- is.numeric(x)
    y_numeric <- is.numeric(y)

    if (x_numeric && y_numeric) {
      plot(x, y,
           pch = 19, cex = 2, col = col,
           xlab = input$x_var, ylab = input$y_var,
           main = paste(input$y_var, "vs", input$x_var),
           cex.lab = 1.3, cex.main = 1.5)

      # Add legend if coloured
      if (input$colour_var != "None" && !is.numeric(data[[input$colour_var]])) {
        legend("topright",
               legend = levels(as.factor(data[[input$colour_var]])),
               col = c("#0d6efd", "#dc3545", "#198754", "#ffc107", "#6f42c1")[1:length(levels(as.factor(data[[input$colour_var]])))],
               pch = 19, cex = 1.2, bg = "white")
      }
    } else if (!x_numeric && y_numeric) {
      boxplot(y ~ x, data = data.frame(x = x, y = y),
              col = c("#0d6efd", "#dc3545", "#198754", "#ffc107"),
              xlab = input$x_var, ylab = input$y_var,
              main = paste(input$y_var, "by", input$x_var),
              cex.lab = 1.3, cex.main = 1.5)
    } else {
      plot(as.factor(x), as.factor(y),
           xlab = input$x_var, ylab = input$y_var,
           main = paste(input$y_var, "vs", input$x_var),
           cex.lab = 1.3, cex.main = 1.5)
    }
  })

  output$summary_table <- renderTable({
    var_data <- data[[input$summary_var]]

    if (input$group_var == "None") {
      data.frame(
        Statistic = c("N", "Mean", "SD", "Min", "Max", "Median"),
        Value = c(
          length(var_data),
          round(mean(var_data, na.rm = TRUE), 2),
          round(sd(var_data, na.rm = TRUE), 2),
          round(min(var_data, na.rm = TRUE), 2),
          round(max(var_data, na.rm = TRUE), 2),
          round(median(var_data, na.rm = TRUE), 2)
        )
      )
    } else {
      groups <- split(var_data, data[[input$group_var]])
      do.call(rbind, lapply(names(groups), function(g) {
        grp <- groups[[g]]
        data.frame(
          Group = g,
          N = length(grp),
          Mean = round(mean(grp, na.rm = TRUE), 2),
          SD = round(sd(grp, na.rm = TRUE), 2),
          Min = round(min(grp, na.rm = TRUE), 2),
          Max = round(max(grp, na.rm = TRUE), 2),
          Median = round(median(grp, na.rm = TRUE), 2)
        )
      }))
    }
  }, striped = TRUE, hover = TRUE, width = "100%")
}

shinyApp(ui, server)