flowchart TD
A[Raw Data] --> B[Server Processing]
B --> C[DT Rendering Engine]
C --> D[Interactive Table Display]
D --> E[User Interactions]
E --> F[Client-Side Events]
F --> G[Server Response]
G --> H[Table Updates]
I[Table Features] --> J[Search & Filter]
I --> K[Sort & Pagination]
I --> L[Column Management]
I --> M[Cell Editing]
I --> N[Export Functions]
O[Performance Layers] --> P[Client-Side Processing]
O --> Q[Server-Side Processing]
O --> R[Lazy Loading]
O --> S[Virtual Scrolling]
style A fill:#e1f5fe
style H fill:#e8f5e8
style I fill:#fff3e0
style O fill:#f3e5f5
Key Takeaways
Tip
- Professional Data Display: DT package transforms basic data frames into sophisticated interactive tables with searching, sorting, and filtering capabilities that rival commercial BI tools
- Performance at Scale: Server-side processing techniques enable smooth interaction with datasets containing millions of rows while maintaining excellent user experience
- Advanced Customization: Comprehensive styling, formatting, and extension options create branded, professional-looking tables that integrate seamlessly with application design
- Interactive Editing: Cell-level editing capabilities transform tables from display-only to dynamic data entry and modification interfaces
- Enterprise Integration: Advanced features including export functionality, column visibility controls, and responsive design support business-critical applications
Introduction
Interactive data tables are the cornerstone of professional data applications, bridging the gap between raw datasets and actionable insights. While basic HTML tables serve simple display purposes, sophisticated data tables enable users to explore, filter, sort, and interact with data in ways that transform static information into dynamic analytical experiences.
The DT package for R provides a comprehensive framework for creating interactive tables in Shiny applications that rival commercial business intelligence platforms in functionality and user experience. This guide covers everything from basic table implementation to advanced server-side processing, custom styling, and interactive editing capabilities that enable professional-grade data exploration tools.
Whether you’re building executive dashboards that need to display thousands of records efficiently, analytical tools that require sophisticated filtering and sorting, or data entry interfaces that allow real-time editing, mastering interactive data tables is essential for creating applications that users actually want to use for their daily data work.
Understanding Interactive Table Architecture
Interactive data tables in Shiny involve coordinated client-server communication that enables real-time data manipulation without page refreshes.
Core DT Components
DataTable Engine: JavaScript-based rendering engine that provides interactive functionality including sorting, searching, and pagination.
Server Integration: Seamless communication between R server logic and client-side table interactions through reactive programming.
Extension Framework: Modular system for adding advanced features like buttons, column filters, responsive design, and custom functionality.
Styling System: Comprehensive theming and customization options that integrate with Bootstrap and custom CSS frameworks.
Strategic Implementation Approaches
Client-Side Processing: Optimal for smaller datasets (under 10,000 rows) where all data is loaded at once for maximum interactivity.
Server-Side Processing: Essential for large datasets where data is processed on the server and only visible portions are sent to the client.
Hybrid Approach: Combines client and server processing for optimal performance with different data sizes and interaction patterns.
Foundation Data Table Implementation
Start with core DT patterns that demonstrate essential functionality and provide the foundation for advanced features.
Basic Interactive Tables
library(shiny)
library(DT)
ui <- fluidPage(
titlePanel("Interactive Data Table Basics"),
fluidRow(
column(12,
h3("Basic Interactive Table"),
DT::dataTableOutput("basic_table")
)
),
br(),
fluidRow(
column(6,
h4("Table Information"),
verbatimTextOutput("table_info")
),
column(6,
h4("Selected Rows"),
verbatimTextOutput("selected_info")
)
)
)
server <- function(input, output, session) {
# Basic interactive table
output$basic_table <- DT::renderDataTable({
DT::datatable(
mtcars,
options = list(
pageLength = 10,
lengthMenu = c(5, 10, 15, 25, 50),
searching = TRUE,
ordering = TRUE,
info = TRUE,
autoWidth = TRUE
),
selection = 'multiple',
filter = 'top',
rownames = TRUE
)
})
# Display table information
output$table_info <- renderPrint({
cat("Dataset: mtcars\n")
cat("Total Rows:", nrow(mtcars), "\n")
cat("Total Columns:", ncol(mtcars), "\n")
cat("Current Page Length:", input$basic_table_state$length %||% 10, "\n")
cat("Search Term:", input$basic_table_search %||% "None", "\n")
})
# Display selected row information
output$selected_info <- renderPrint({
selected_rows <- input$basic_table_rows_selected
if(length(selected_rows) > 0) {
cat("Selected Rows:", paste(selected_rows, collapse = ", "), "\n")
cat("Selected Data:\n")
print(mtcars[selected_rows, c("mpg", "cyl", "hp")])
} else {
cat("No rows selected")
}
})
}
shinyApp(ui = ui, server = server)# Enhanced table with comprehensive configuration
server <- function(input, output, session) {
# Sample dataset for demonstration
sample_data <- reactive({
data.frame(
ID = 1:100,
Name = paste("Item", 1:100),
Category = sample(c("Electronics", "Clothing", "Books", "Home"), 100, replace = TRUE),
Price = round(runif(100, 10, 500), 2),
InStock = sample(c(TRUE, FALSE), 100, replace = TRUE),
Rating = round(runif(100, 1, 5), 1),
LastUpdated = sample(seq(as.Date("2024-01-01"), Sys.Date(), by = "day"), 100),
stringsAsFactors = FALSE
)
})
# Advanced configured table
output$advanced_table <- DT::renderDataTable({
data <- sample_data()
DT::datatable(
data,
# Table options
options = list(
# Pagination
pageLength = 15,
lengthMenu = list(c(10, 15, 25, 50, -1), c("10", "15", "25", "50", "All")),
# Search and filter
searching = TRUE,
search = list(regex = TRUE, caseInsensitive = TRUE),
# Column configuration
columnDefs = list(
list(width = "80px", targets = 0), # ID column width
list(className = "dt-center", targets = c(0, 4, 5)), # Center alignment
list(visible = FALSE, targets = c(6)) # Hide LastUpdated initially
),
# Styling
autoWidth = TRUE,
scrollX = TRUE,
scrollY = "400px",
scrollCollapse = TRUE,
# Additional features
stateSave = TRUE,
dom = 'Blfrtip',
buttons = c('copy', 'csv', 'excel', 'pdf', 'print', 'colvis')
),
# Extensions
extensions = c('Buttons', 'ColReorder', 'FixedHeader'),
# Selection and filtering
selection = list(mode = 'multiple', target = 'row'),
filter = list(position = 'top', clear = FALSE),
# Row names
rownames = FALSE
) %>%
# Format specific columns
DT::formatCurrency(columns = "Price", currency = "$") %>%
DT::formatDate(columns = "LastUpdated", method = "toLocaleDateString") %>%
DT::formatRound(columns = "Rating", digits = 1) %>%
# Style specific columns
DT::formatStyle(
columns = "InStock",
backgroundColor = DT::styleEqual(c(TRUE, FALSE), c("lightgreen", "lightcoral")),
fontWeight = "bold"
) %>%
# Conditional formatting for ratings
DT::formatStyle(
columns = "Rating",
backgroundColor = DT::styleInterval(
cuts = c(2, 3, 4),
values = c("lightcoral", "lightyellow", "lightblue", "lightgreen")
)
)
})
# Reactive values for table state
table_state <- reactiveValues(
filtered_data = NULL,
selected_rows = NULL
)
# Update filtered data when table changes
observeEvent(input$advanced_table_rows_all, {
if(length(input$advanced_table_rows_all) > 0) {
table_state$filtered_data <- sample_data()[input$advanced_table_rows_all, ]
} else {
table_state$filtered_data <- sample_data()
}
})
# Track selected rows
observeEvent(input$advanced_table_rows_selected, {
table_state$selected_rows <- input$advanced_table_rows_selected
})
# Display table statistics
output$table_stats <- renderUI({
total_rows <- nrow(sample_data())
filtered_rows <- length(input$advanced_table_rows_all %||% seq_len(total_rows))
selected_rows <- length(table_state$selected_rows %||% c())
div(
class = "row",
div(class = "col-md-4",
div(class = "panel panel-info",
div(class = "panel-body text-center",
h4(total_rows),
p("Total Records")
)
)
),
div(class = "col-md-4",
div(class = "panel panel-success",
div(class = "panel-body text-center",
h4(filtered_rows),
p("Filtered Records")
)
)
),
div(class = "col-md-4",
div(class = "panel panel-warning",
div(class = "panel-body text-center",
h4(selected_rows),
p("Selected Records")
)
)
)
)
})
}Server-Side Processing for Large Datasets
Implement server-side processing to handle datasets that exceed client-side performance limits:
server <- function(input, output, session) {
# Large dataset simulation
large_dataset <- reactive({
# In practice, this would come from a database
n_rows <- 100000
data.frame(
ID = 1:n_rows,
Customer = paste("Customer", sample(1:10000, n_rows, replace = TRUE)),
Product = sample(c("Product A", "Product B", "Product C", "Product D"), n_rows, replace = TRUE),
Amount = round(runif(n_rows, 10, 1000), 2),
Date = sample(seq(as.Date("2020-01-01"), Sys.Date(), by = "day"), n_rows, replace = TRUE),
Region = sample(c("North", "South", "East", "West"), n_rows, replace = TRUE),
Status = sample(c("Active", "Pending", "Completed", "Cancelled"), n_rows, replace = TRUE),
stringsAsFactors = FALSE
)
})
# Server-side processing table
output$server_side_table <- DT::renderDataTable({
DT::datatable(
large_dataset(),
options = list(
# Enable server-side processing
serverSide = TRUE,
processing = TRUE,
# Pagination
pageLength = 25,
lengthMenu = c(10, 25, 50, 100),
# Search configuration
searching = TRUE,
search = list(
regex = FALSE,
caseInsensitive = TRUE,
smart = TRUE
),
# Column-specific search
searchCols = list(
NULL, NULL, NULL, NULL, NULL,
list(search = 'North|South', regex = TRUE), # Region filter
NULL
),
# Performance optimizations
deferRender = TRUE,
scrollX = TRUE,
scroller = TRUE,
# UI elements
dom = 'Blfrtip',
buttons = c('copy', 'csv', 'excel'),
# Column definitions
columnDefs = list(
list(className = "dt-center", targets = c(0, 3, 6)),
list(width = "100px", targets = c(0, 3))
)
),
extensions = c('Buttons', 'Scroller'),
filter = 'top',
selection = 'multiple',
rownames = FALSE
) %>%
# Formatting
DT::formatCurrency("Amount", currency = "$") %>%
DT::formatDate("Date") %>%
# Conditional styling
DT::formatStyle(
"Status",
backgroundColor = DT::styleEqual(
c("Active", "Pending", "Completed", "Cancelled"),
c("lightgreen", "lightyellow", "lightblue", "lightcoral")
)
)
})
# Performance monitoring
output$performance_info <- renderText({
# Simulate performance metrics
total_rows <- nrow(large_dataset())
current_page <- input$server_side_table_state$start %||% 0
page_length <- input$server_side_table_state$length %||% 25
paste0(
"Dataset: ", format(total_rows, big.mark = ","), " rows | ",
"Current view: rows ", current_page + 1, "-",
min(current_page + page_length, total_rows), " | ",
"Page size: ", page_length
)
})
}Interactive DT Configuration Mastery
The true power of DT tables lies in understanding how different configuration options work together to create the perfect user experience. Rather than memorizing dozens of parameters, you can experiment with live configurations and see instant results.
Interactive Demo: Master DT Configuration Like a Pro
Transform table configuration from guesswork to precision:
- Test quick scenarios - Jump into common configurations with one-click presets (Basic, Advanced, Enterprise, Performance)
- Configure in real-time - Watch every option change instantly update your table display with live preview
- Generate production code - Copy perfect R code for immediate use in your applications with zero modifications needed
- Monitor performance - See how different features affect rendering speed and memory usage in real-time
- Compare configurations - Understand trade-offs between functionality and performance across different scenarios
Key Learning: Master DT’s extensive configuration options through hands-on experimentation, understanding exactly how each feature impacts both user experience and application performance.
#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| components: [viewer]
#| viewerHeight: 1800
library(shiny)
library(bslib)
library(bsicons)
library(DT)
ui <- fluidPage(
theme = bs_theme(version = 5, bootswatch = "cosmo"),
tags$head(
tags$style(HTML("
@import url('https://fonts.googleapis.com/css2?family=JetBrains+Mono:wght@400;700&display=swap');
.config-panel {
background: linear-gradient(135deg, #667eea 0%, #764ba2 100%);
color: white;
border-radius: 12px;
padding: 20px;
margin-bottom: 20px;
box-shadow: 0 8px 32px rgba(0,0,0,0.1);
}
.config-panel h4 {
margin-bottom: 15px;
text-shadow: 0 2px 4px rgba(0,0,0,0.3);
}
.demo-section {
background: white;
border-radius: 12px;
padding: 20px;
margin: 10px 0;
box-shadow: 0 4px 20px rgba(0,0,0,0.1);
}
.code-output {
background: #2d3748;
color: #e2e8f0;
border-radius: 8px;
padding: 15px;
font-family: 'JetBrains Mono', monospace;
font-size: 0.9rem;
max-height: 400px;
overflow-y: auto;
margin-top: 15px;
position: relative;
}
#generated_code {
color: #abb2bf;
}
.copy-button {
position: absolute;
top: 10px;
right: 10px;
background: #4a5568;
color: white;
border: none;
border-radius: 4px;
padding: 5px 10px;
font-size: 0.8rem;
cursor: pointer;
}
.copy-button:hover {
background: #2d3748;
}
.feature-count {
background: linear-gradient(135deg, #0d6efd, #6610f2);
color: white;
padding: 8px 16px;
border-radius: 25px;
font-size: 1rem;
font-weight: bold;
display: inline-block;
min-width: 50px;
text-align: center;
box-shadow: 0 4px 15px rgba(13, 110, 253, 0.3);
animation: pulse-glow 2s infinite;
}
@keyframes pulse-glow {
0%, 100% { box-shadow: 0 4px 15px rgba(13, 110, 253, 0.3); }
50% { box-shadow: 0 4px 25px rgba(13, 110, 253, 0.6); }
}
.performance-indicator {
position: fixed;
top: 20px;
right: 20px;
background: #28a745;
color: white;
padding: 10px 20px;
border-radius: 25px;
font-weight: bold;
z-index: 1000;
animation: pulse 2s infinite;
}
@keyframes pulse {
0%, 100% { opacity: 1; }
50% { opacity: 0.7; }
}
.scenario-selector {
background: linear-gradient(135deg, #fd7e14, #e55d00);
color: white;
border-radius: 12px;
padding: 20px;
margin: 20px 0;
}
.btn-scenario {
background: rgba(255,255,255,0.2);
border: 2px solid rgba(255,255,255,0.3);
color: white;
margin: 5px;
transition: all 0.3s ease;
}
.btn-scenario:hover {
background: rgba(255,255,255,0.3);
border-color: rgba(255,255,255,0.5);
color: white;
transform: translateY(-2px);
}
.stats-panel {
background: linear-gradient(135deg, #17a2b8, #138496);
color: white;
border-radius: 12px;
padding: 20px;
margin: 20px 0;
}
.stat-card {
background: rgba(255,255,255,0.1);
border-radius: 8px;
padding: 15px;
text-align: center;
backdrop-filter: blur(10px);
}
.stat-value {
font-size: 2rem;
font-weight: bold;
display: block;
}
.config-option {
background: #f8f9fa;
border: 1px solid #dee2e6;
border-radius: 8px;
padding: 10px;
margin: 5px 0;
color: #212529;
}
.option-active {
border-color: #0d6efd;
background: #e7f3ff;
}
.data-preview {
max-height: 200px;
overflow-y: auto;
border: 1px solid #dee2e6;
border-radius: 8px;
padding: 10px;
margin: 10px 0;
background: #f8f9fa;
}
"))
),
# Performance indicator
div(class = "performance-indicator",
bs_icon("lightning-charge"), " LIVE DT CONFIGURATION"
),
titlePanel(
div(style = "text-align: center; margin-bottom: 30px;",
h1(bs_icon("table"), "DT Configuration Playground",
style = "background: linear-gradient(135deg, #667eea 0%, #764ba2 100%);
-webkit-background-clip: text; -webkit-text-fill-color: transparent;
font-weight: bold;"),
p("Master DT package features with real-time configuration and instant code generation",
class = "lead", style = "color: #6c757d;")
)
),
# Scenario Testing
div(class = "scenario-selector",
h4(bs_icon("play-circle"), "Quick Start Scenarios"),
p("Jump into common table configurations:"),
fluidRow(
column(3,
actionButton("scenario_basic", "Basic Table", class = "btn-scenario btn-block")
),
column(3,
actionButton("scenario_advanced", "Advanced Features", class = "btn-scenario btn-block")
),
column(3,
actionButton("scenario_enterprise", "Enterprise Style", class = "btn-scenario btn-block")
),
column(3,
actionButton("scenario_performance", "Large Dataset", class = "btn-scenario btn-block")
)
)
),
fluidRow(
# Configuration Panel
column(4,
div(class = "config-panel",
h4(bs_icon("sliders"), "Table Configuration"),
# Dataset Selection
selectInput("dataset_choice", "Dataset:",
choices = c("mtcars" = "mtcars",
"iris" = "iris",
"diamonds (large)" = "diamonds",
"custom sample" = "custom"),
selected = "mtcars"),
# Basic Options
h5(bs_icon("gear"), "Basic Options"),
div(class = "config-option",
checkboxInput("show_pageLength", "Page Length Controls", TRUE),
conditionalPanel(
"input.show_pageLength",
numericInput("pageLength", "Default Page Length:", 10, min = 5, max = 100)
)
),
div(class = "config-option",
checkboxInput("show_searching", "Global Search", TRUE)
),
div(class = "config-option",
checkboxInput("show_ordering", "Column Sorting", TRUE)
),
div(class = "config-option",
checkboxInput("show_info", "Table Information", TRUE)
),
# Filtering Options
h5(bs_icon("funnel"), "Filtering"),
div(class = "config-option",
checkboxInput("column_filters", "Column Filters", FALSE),
conditionalPanel(
"input.column_filters",
selectInput("filter_position", "Filter Position:",
choices = c("top", "bottom"), selected = "top")
)
),
# Extensions and Features
h5(bs_icon("puzzle"), "Extensions"),
div(class = "config-option",
checkboxInput("enable_buttons", "Buttons Extension", TRUE),
conditionalPanel(
"input.enable_buttons",
checkboxGroupInput("button_types", "Button Types:",
choices = c("copy", "csv", "excel", "pdf", "print", "colvis"),
selected = c("copy", "csv"), inline = TRUE)
)
),
div(class = "config-option",
checkboxInput("enable_scroller", "Scroller Extension", FALSE)
),
div(class = "config-option",
checkboxInput("enable_responsive", "Responsive Extension", FALSE)
)
),
# Performance Stats
div(class = "stats-panel",
h4(bs_icon("speedometer2"), "Performance Metrics"),
fluidRow(
column(6,
div(class = "stat-card",
span(class = "stat-value", textOutput("row_count", container = span)),
"Total Rows"
)
),
column(6,
div(class = "stat-card",
span(class = "stat-value", textOutput("feature_count", container = span)),
"Active Features"
)
)
),
fluidRow(
column(6,
div(class = "stat-card",
span(class = "stat-value", textOutput("render_time", container = span)),
"Render Time (ms)"
)
),
column(6,
div(class = "stat-card",
span(class = "stat-value", textOutput("table_size", container = span)),
"Table Size (KB)"
)
)
)
)
),
# Demo Table and Code Output
column(8,
div(class = "demo-section",
h4(bs_icon("table"), "Live Table Preview"),
p("Watch your configuration changes apply in real-time:"),
DT::dataTableOutput("demo_table")
),
div(class = "demo-section",
h4(bs_icon("code-square"), "Generated R Code"),
p("Copy this code to use in your own applications:"),
div(class = "code-output",
tags$button(class = "copy-button", bs_icon("clipboard"), onclick = "copyCode()"),
verbatimTextOutput("generated_code")
)
),
div(class = "demo-section",
h4(bs_icon("info-circle"), "Configuration Summary"),
DT::dataTableOutput("config_summary")
)
)
),
# JavaScript for copy functionality
tags$script(HTML("
function copyCode() {
const codeElement = document.querySelector('#generated_code');
const textToCopy = codeElement.textContent;
navigator.clipboard.writeText(textToCopy).then(function() {
// Show success feedback
const button = document.querySelector('.copy-button');
const originalText = button.innerHTML;
button.innerHTML = 'Copied!';
button.style.background = '#28a745';
setTimeout(function() {
button.innerHTML = originalText;
button.style.background = '#4a5568';
}, 2000);
});
}
"))
)
server <- function(input, output, session) {
# Reactive values for tracking
counters <- reactiveValues(
table_renders = 0,
config_changes = 0,
feature_count = 0,
last_render_time = 0
)
# Sample datasets
datasets <- list(
"mtcars" = mtcars,
"iris" = iris,
"diamonds" = if(requireNamespace("ggplot2", quietly = TRUE)) ggplot2::diamonds else mtcars,
"custom" = data.frame(
ID = 1:100,
Name = paste("Item", 1:100),
Category = sample(c("Electronics", "Clothing", "Books", "Home"), 100, replace = TRUE),
Price = round(runif(100, 10, 500), 2),
InStock = sample(c(TRUE, FALSE), 100, replace = TRUE),
Rating = round(runif(100, 1, 5), 1),
LastUpdated = sample(seq(as.Date("2024-01-01"), Sys.Date(), by = "day"), 100),
stringsAsFactors = FALSE
)
)
# Get current dataset
current_data <- reactive({
datasets[[input$dataset_choice]]
})
# Generate DT options based on configuration
dt_options <- reactive({
# Track configuration changes
isolate(counters$config_changes <- counters$config_changes + 1)
options_list <- list()
extensions_list <- c()
feature_count <- 0
# Basic options
if(input$show_pageLength) {
options_list$pageLength <- input$pageLength
options_list$lengthMenu <- c(5, 10, 15, 25, 50, 100)
feature_count <- feature_count + 1
}
options_list$searching <- input$show_searching
if(input$show_searching) feature_count <- feature_count + 1
options_list$ordering <- input$show_ordering
if(input$show_ordering) feature_count <- feature_count + 1
options_list$info <- input$show_info
if(input$show_info) feature_count <- feature_count + 1
# Extensions
if(input$enable_buttons) {
extensions_list <- c(extensions_list, "Buttons")
options_list$dom <- "Bfrtip"
options_list$buttons <- input$button_types
feature_count <- feature_count + length(input$button_types)
} else {
options_list$dom <- "frtip"
}
if(input$enable_scroller) {
extensions_list <- c(extensions_list, "Scroller")
options_list$scrollY <- "400px"
options_list$scroller <- TRUE
feature_count <- feature_count + 1
}
if(input$enable_responsive) {
extensions_list <- c(extensions_list, "Responsive")
feature_count <- feature_count + 1
}
# Performance optimization for large datasets
if(nrow(current_data()) > 1000) {
options_list$deferRender <- TRUE
options_list$processing <- TRUE
}
counters$feature_count <- feature_count
list(
options = options_list,
extensions = if(length(extensions_list) > 0) extensions_list else list(),
filter = if(input$column_filters) input$filter_position else "none",
selection = "multiple"
)
})
# Main demo table
output$demo_table <- DT::renderDataTable({
start_time <- Sys.time()
config <- dt_options()
data <- current_data()
# Create the datatable
dt <- DT::datatable(
data,
options = config$options,
extensions = config$extensions,
filter = list(position = config$filter),
selection = config$selection,
rownames = FALSE
)
# Apply formatting based on data type
numeric_cols <- sapply(data, is.numeric)
if(any(numeric_cols)) {
numeric_col_names <- names(data)[numeric_cols]
for(col in numeric_col_names) {
if(grepl("price|cost|amount", tolower(col))) {
dt <- dt %>% DT::formatCurrency(col, currency = "$")
} else if(grepl("rating|score", tolower(col))) {
dt <- dt %>% DT::formatRound(col, digits = 1)
}
}
}
# Track rendering time
end_time <- Sys.time()
isolate({
counters$table_renders <- counters$table_renders + 1
counters$last_render_time <- round(as.numeric(difftime(end_time, start_time, units = "secs")) * 1000, 2)
})
dt
})
# Generated code output
output$generated_code <- renderText({
config <- dt_options()
data_name <- input$dataset_choice
code_lines <- c(
"library(DT)",
"",
"# Create interactive data table",
paste0("DT::datatable("),
paste0(" ", data_name, ","),
"",
" # Table options"
)
# Add options
options_code <- c(" options = list(")
for(i in seq_along(config$options)) {
opt_name <- names(config$options)[i]
opt_value <- config$options[[i]]
if(is.logical(opt_value)) {
opt_str <- paste0(" ", opt_name, " = ", toupper(opt_value))
} else if(is.character(opt_value)) {
if(length(opt_value) == 1) {
opt_str <- paste0(" ", opt_name, " = \"", opt_value, "\"")
} else {
opt_str <- paste0(" ", opt_name, " = c(", paste0("\"", opt_value, "\"", collapse = ", "), ")")
}
} else if(is.numeric(opt_value)) {
if(length(opt_value) == 1) {
opt_str <- paste0(" ", opt_name, " = ", opt_value)
} else {
opt_str <- paste0(" ", opt_name, " = c(", paste(opt_value, collapse = ", "), ")")
}
} else if(is.list(opt_value)) {
opt_str <- paste0(" ", opt_name, " = TRUE # Complex list option")
} else {
opt_str <- paste0(" ", opt_name, " = ", opt_value)
}
if(i < length(config$options)) {
opt_str <- paste0(opt_str, ",")
}
options_code <- c(options_code, opt_str)
}
options_code <- c(options_code, " ),")
code_lines <- c(code_lines, options_code, "")
# Add extensions
if(!is.null(config$extensions)) {
ext_code <- paste0(" extensions = c(", paste0("\"", config$extensions, "\"", collapse = ", "), "),")
code_lines <- c(code_lines, ext_code)
}
# Add filter and selection
if(config$filter != "none") {
code_lines <- c(code_lines, paste0(" filter = list(position = \"", config$filter, "\"),"))
}
code_lines <- c(code_lines,
" selection = \"multiple\",",
" rownames = FALSE",
")")
paste(code_lines, collapse = "\n")
})
# Configuration summary table
output$config_summary <- DT::renderDataTable({
config <- dt_options()
summary_data <- data.frame(
Feature = c("Page Length", "Global Search", "Column Sorting", "Table Info",
"Column Filters", "Buttons Extension", "Scroller", "Responsive"),
Status = c(
ifelse(input$show_pageLength, "Enabled", "Disabled"),
ifelse(input$show_searching, "Enabled", "Disabled"),
ifelse(input$show_ordering, "Enabled", "Disabled"),
ifelse(input$show_info, "Enabled", "Disabled"),
ifelse(input$column_filters, "Enabled", "Disabled"),
ifelse(input$enable_buttons, "Enabled", "Disabled"),
ifelse(input$enable_scroller, "Enabled", "Disabled"),
ifelse(input$enable_responsive, "Enabled", "Disabled")
),
Details = c(
ifelse(input$show_pageLength, paste("Default:", input$pageLength), "N/A"),
ifelse(input$show_searching, "Global search box", "N/A"),
ifelse(input$show_ordering, "Click column headers", "N/A"),
ifelse(input$show_info, "Showing X of Y entries", "N/A"),
ifelse(input$column_filters, paste("Position:", input$filter_position), "N/A"),
ifelse(input$enable_buttons, paste(length(input$button_types), "buttons"), "N/A"),
ifelse(input$enable_scroller, "Virtual scrolling", "N/A"),
ifelse(input$enable_responsive, "Mobile-friendly", "N/A")
),
stringsAsFactors = FALSE
)
DT::datatable(
summary_data,
options = list(
pageLength = 10,
searching = FALSE,
ordering = FALSE,
info = FALSE,
paging = FALSE,
dom = "t"
),
rownames = FALSE
) %>%
DT::formatStyle(
"Status",
backgroundColor = DT::styleEqual(c("Enabled", "Disabled"), c("lightgreen", "lightcoral")),
fontWeight = "bold"
)
})
# Performance metrics
output$row_count <- renderText({
format(nrow(current_data()), big.mark = ",")
})
output$feature_count <- renderText({
counters$feature_count
})
output$render_time <- renderText({
if(counters$last_render_time > 0) {
paste0(counters$last_render_time, " ms")
} else {
"0 ms"
}
})
output$table_size <- renderText({
# Estimate table size based on data and features
base_size <- object.size(current_data()) / 1024 # Convert to KB
feature_overhead <- counters$feature_count * 2 # 2KB per feature
total_size <- round(as.numeric(base_size) + feature_overhead, 1)
paste0(total_size, " KB")
})
# Scenario buttons
observeEvent(input$scenario_basic, {
updateSelectInput(session, "dataset_choice", selected = "mtcars")
updateCheckboxInput(session, "show_pageLength", value = TRUE)
updateNumericInput(session, "pageLength", value = 10)
updateCheckboxInput(session, "show_searching", value = TRUE)
updateCheckboxInput(session, "show_ordering", value = TRUE)
updateCheckboxInput(session, "show_info", value = TRUE)
updateCheckboxInput(session, "column_filters", value = FALSE)
updateCheckboxInput(session, "enable_buttons", value = FALSE)
updateCheckboxInput(session, "enable_scroller", value = FALSE)
updateCheckboxInput(session, "enable_responsive", value = FALSE)
showNotification("Applied basic table configuration", type = "message", duration = 3)
})
observeEvent(input$scenario_advanced, {
updateSelectInput(session, "dataset_choice", selected = "custom")
updateCheckboxInput(session, "show_pageLength", value = TRUE)
updateNumericInput(session, "pageLength", value = 15)
updateCheckboxInput(session, "show_searching", value = TRUE)
updateCheckboxInput(session, "show_ordering", value = TRUE)
updateCheckboxInput(session, "show_info", value = TRUE)
updateCheckboxInput(session, "column_filters", value = TRUE)
updateSelectInput(session, "filter_position", selected = "top")
updateCheckboxInput(session, "enable_buttons", value = TRUE)
updateCheckboxGroupInput(session, "button_types", selected = c("copy", "csv", "excel"))
updateCheckboxInput(session, "enable_responsive", value = TRUE)
showNotification("Applied advanced features configuration", type = "message", duration = 3)
})
observeEvent(input$scenario_enterprise, {
updateSelectInput(session, "dataset_choice", selected = "custom")
updateCheckboxInput(session, "show_pageLength", value = TRUE)
updateNumericInput(session, "pageLength", value = 25)
updateCheckboxInput(session, "show_searching", value = TRUE)
updateCheckboxInput(session, "show_ordering", value = TRUE)
updateCheckboxInput(session, "show_info", value = TRUE)
updateCheckboxInput(session, "column_filters", value = TRUE)
updateCheckboxInput(session, "enable_buttons", value = TRUE)
updateCheckboxGroupInput(session, "button_types", selected = c("copy", "csv", "excel", "pdf", "colvis"))
updateCheckboxInput(session, "enable_responsive", value = TRUE)
showNotification("Applied enterprise-grade configuration", type = "message", duration = 3)
})
observeEvent(input$scenario_performance, {
updateSelectInput(session, "dataset_choice", selected = "diamonds")
updateCheckboxInput(session, "show_pageLength", value = TRUE)
updateNumericInput(session, "pageLength", value = 25)
updateCheckboxInput(session, "show_searching", value = TRUE)
updateCheckboxInput(session, "show_ordering", value = TRUE)
updateCheckboxInput(session, "show_info", value = TRUE)
updateCheckboxInput(session, "column_filters", value = FALSE)
updateCheckboxInput(session, "enable_buttons", value = TRUE)
updateCheckboxGroupInput(session, "button_types", selected = c("copy", "csv"))
updateCheckboxInput(session, "enable_scroller", value = TRUE)
updateCheckboxInput(session, "enable_responsive", value = TRUE)
showNotification("Applied large dataset performance configuration", type = "message", duration = 3)
})
}
shinyApp(ui = ui, server = server)
Advanced Table Features and Customization
Interactive Editing and Cell Modification
Transform tables from display-only to interactive data entry interfaces:
server <- function(input, output, session) {
# Editable dataset
editable_data <- reactiveValues(
df = data.frame(
ID = 1:10,
Name = paste("Item", 1:10),
Category = sample(c("A", "B", "C"), 10, replace = TRUE),
Value = round(runif(10, 1, 100), 1),
Active = sample(c(TRUE, FALSE), 10, replace = TRUE),
Notes = paste("Note", 1:10),
stringsAsFactors = FALSE
)
)
# Editable table
output$editable_table <- DT::renderDataTable({
DT::datatable(
editable_data$df,
options = list(
pageLength = 25,
searching = TRUE,
ordering = TRUE,
# Enable column-specific editing
columnDefs = list(
list(targets = 0, editable = FALSE), # ID not editable
list(targets = c(1, 3, 5), className = "editable"),
list(targets = 2,
editor = list(
type = "select",
options = list(
list(label = "Category A", value = "A"),
list(label = "Category B", value = "B"),
list(label = "Category C", value = "C")
)
)
)
),
# Editing configuration
keys = TRUE,
autoFill = TRUE,
select = TRUE
),
extensions = c('KeyTable', 'AutoFill', 'Select'),
editable = list(
target = 'cell',
disable = list(columns = c(0)) # Disable editing for ID column
),
selection = 'none'
)
})
# Handle cell edits
observeEvent(input$editable_table_cell_edit, {
info <- input$editable_table_cell_edit
# Update the data
row <- info$row
col <- info$col + 1 # R is 1-indexed, JavaScript is 0-indexed
value <- info$value
# Validate and convert value based on column type
if(col == 2) { # Name column
if(nchar(value) == 0) {
showNotification("Name cannot be empty", type = "error")
return()
}
editable_data$df[row, col] <- value
} else if(col == 3) { # Category column
if(!value %in% c("A", "B", "C")) {
showNotification("Invalid category", type = "error")
return()
}
editable_data$df[row, col] <- value
} else if(col == 4) { # Value column
numeric_value <- suppressWarnings(as.numeric(value))
if(is.na(numeric_value)) {
showNotification("Value must be numeric", type = "error")
return()
}
editable_data$df[row, col] <- numeric_value
} else if(col == 5) { # Active column
logical_value <- as.logical(value)
editable_data$df[row, col] <- logical_value
} else if(col == 6) { # Notes column
editable_data$df[row, col] <- value
}
# Show success notification
showNotification("Cell updated successfully", type = "message", duration = 2)
})
# Add new row functionality
observeEvent(input$add_row, {
new_id <- max(editable_data$df$ID) + 1
new_row <- data.frame(
ID = new_id,
Name = paste("New Item", new_id),
Category = "A",
Value = 0,
Active = TRUE,
Notes = "",
stringsAsFactors = FALSE
)
editable_data$df <- rbind(editable_data$df, new_row)
showNotification("New row added", type = "message")
})
# Delete selected rows
observeEvent(input$delete_rows, {
selected_rows <- input$editable_table_rows_selected
if(length(selected_rows) > 0) {
editable_data$df <- editable_data$df[-selected_rows, ]
showNotification(paste("Deleted", length(selected_rows), "rows"), type = "message")
} else {
showNotification("No rows selected for deletion", type = "warning")
}
})
# Export functionality
output$download_data <- downloadHandler(
filename = function() {
paste("edited_data_", Sys.Date(), ".csv", sep = "")
},
content = function(file) {
write.csv(editable_data$df, file, row.names = FALSE)
}
)
# Display current data summary
output$data_summary <- renderUI({
df <- editable_data$df
div(
h4("Data Summary"),
p(paste("Total rows:", nrow(df))),
p(paste("Categories:", paste(unique(df$Category), collapse = ", "))),
p(paste("Active items:", sum(df$Active))),
p(paste("Average value:", round(mean(df$Value), 2)))
)
})
}Custom Styling and Theming
Create professional, branded table appearances that integrate with application design:
# Custom table styling and themes
create_styled_table <- function(data, theme = "corporate") {
# Define theme-specific styling
theme_config <- switch(theme,
"corporate" = list(
class = "stripe hover order-column",
dom = 'Bfrtip',
buttons = list(
list(extend = 'copy', className = 'btn btn-primary btn-sm'),
list(extend = 'csv', className = 'btn btn-success btn-sm'),
list(extend = 'excel', className = 'btn btn-info btn-sm'),
list(extend = 'pdf', className = 'btn btn-warning btn-sm')
)
),
"modern" = list(
class = "cell-border compact",
dom = 'Blfrtip',
buttons = c('copy', 'csv', 'excel', 'colvis')
),
"minimal" = list(
class = "display nowrap",
dom = 'frtip'
)
)
# Create the datatable
dt <- DT::datatable(
data,
options = list(
pageLength = 15,
lengthMenu = c(10, 15, 25, 50),
searching = TRUE,
ordering = TRUE,
autoWidth = TRUE,
scrollX = TRUE,
# Apply theme configuration
dom = theme_config$dom,
buttons = theme_config$buttons,
# Custom styling
columnDefs = list(
list(className = "dt-center", targets = "_all")
),
# Header styling
initComplete = DT::JS(
"function(settings, json) {",
"$('th').css('background-color', '#f8f9fa');",
"$('th').css('border-bottom', '2px solid #dee2e6');",
"}"
)
),
class = theme_config$class,
extensions = c('Buttons', 'ColReorder', 'Responsive'),
filter = 'top',
selection = 'multiple'
)
# Apply conditional formatting based on theme
if(theme == "corporate") {
# Corporate theme: professional color scheme
dt <- dt %>%
DT::formatStyle(
columns = names(data),
backgroundColor = '#ffffff',
borderLeft = '1px solid #dee2e6'
)
} else if(theme == "modern") {
# Modern theme: sleek appearance
dt <- dt %>%
DT::formatStyle(
columns = names(data),
background = 'linear-gradient(135deg, #667eea 0%, #764ba2 100%)',
backgroundSize = '200% 200%',
color = 'white'
)
}
return(dt)
}
# Usage in server
server <- function(input, output, session) {
# Themed tables
output$corporate_table <- DT::renderDataTable({
create_styled_table(mtcars, "corporate")
})
output$modern_table <- DT::renderDataTemplate({
create_styled_table(iris, "modern")
})
# Custom CSS injection for advanced styling
output$custom_styled_table <- DT::renderDataTable({
DT::datatable(
mtcars,
options = list(
pageLength = 10,
dom = 'Bfrtip',
buttons = c('copy', 'csv', 'excel'),
# Custom CSS classes
columnDefs = list(
list(className = "highlight-cell", targets = c(0, 1)),
list(className = "currency-cell", targets = c(5, 6))
),
# Row callback for custom styling
rowCallback = DT::JS(
"function(row, data, index) {",
" if(data[1] > 6) {",
" $(row).addClass('high-performance');",
" }",
"}"
)
),
extensions = 'Buttons'
) %>%
# Advanced conditional formatting
DT::formatStyle(
"mpg",
background = DT::styleColorBar(range(mtcars$mpg), 'lightblue'),
backgroundSize = '100% 90%',
backgroundRepeat = 'no-repeat',
backgroundPosition = 'center'
) %>%
# Multi-condition styling
DT::formatStyle(
"hp",
backgroundColor = DT::styleInterval(
cuts = quantile(mtcars$hp, c(0.25, 0.5, 0.75)),
values = c('lightcoral', 'lightyellow', 'lightgreen', 'lightblue')
),
fontWeight = DT::styleInterval(
cuts = quantile(mtcars$hp, 0.75),
values = c('normal', 'bold')
)
)
})
}
# Custom CSS to be included in UI
custom_table_css <- "
.highlight-cell {
background-color: #fffacd !important;
font-weight: bold;
}
.currency-cell {
color: #008000;
font-family: monospace;
}
.high-performance {
background-color: #f0f8ff !important;
border-left: 4px solid #4169e1;
}
.dataTables_wrapper .dataTables_paginate .paginate_button {
border-radius: 4px;
margin: 0 2px;
}
.dataTables_wrapper .dataTables_paginate .paginate_button.current {
background: linear-gradient(135deg, #667eea 0%, #764ba2 100%);
color: white !important;
border: none;
}
"Visual Theme Laboratory
Professional table styling goes beyond basic formatting to create cohesive, branded experiences that match your application’s design language. Understanding how themes, colors, and formatting work together enables you to create tables that feel integrated rather than generic.
Interactive Demo: Design Professional Table Themes
Master advanced styling with real-time preview:
- Choose base themes - Select from Corporate, Modern, Minimal, or Vibrant predefined styles
- Customize colors live - Adjust header colors, stripe colors, and hover effects with instant feedback
- Apply conditional formatting - See how value-based colors and formatting enhance data readability
- Generate styling code - Get both R code and custom CSS for your exact configuration
- Learn best practices - Understand professional styling guidelines and accessibility considerations
Key Learning: Transform basic tables into polished, professional interfaces that enhance rather than distract from your data story.
#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| components: [viewer]
#| viewerHeight: 1500
library(shiny)
library(bslib)
library(bsicons)
library(DT)
# Workaround for Chromium Issue 468227
downloadButton <- function(...) {
tag <- shiny::downloadButton(...)
tag$attribs$download <- NULL
tag
}
ui <- fluidPage(
theme = bs_theme(version = 5, bootswatch = "cosmo"),
tags$head(
tags$style(HTML("
.styling-panel {
background: linear-gradient(135deg, #6610f2 0%, #6f42c1 100%);
color: white;
border-radius: 12px;
padding: 20px;
margin-bottom: 20px;
box-shadow: 0 8px 32px rgba(0,0,0,0.1);
}
.theme-card {
background: white;
border-radius: 8px;
padding: 15px;
margin: 10px 0;
box-shadow: 0 4px 15px rgba(0,0,0,0.1);
cursor: pointer;
transition: all 0.3s ease;
color: #212529;
}
.theme-card:hover {
transform: translateY(-2px);
box-shadow: 0 6px 25px rgba(0,0,0,0.15);
}
.theme-card.active {
border: 3px solid #0d6efd;
transform: translateY(-2px);
}
.preview-section {
background: white;
border-radius: 12px;
padding: 20px;
margin: 10px 0;
box-shadow: 0 4px 20px rgba(0,0,0,0.1);
}
.style-controls {
background: #f8f9fa;
border-radius: 8px;
padding: 15px;
margin: 10px 0;
}
.code-actions {
background: #f8f9fa;
border-radius: 8px;
padding: 10px;
margin-bottom: 10px;
text-align: center;
}
.download-btn {
margin: 0 5px;
}
.theme-healthcare { border-left: 4px solid #28a745; }
.theme-financial { border-left: 4px solid #007bff; }
.theme-scientific { border-left: 4px solid #6f42c1; }
.theme-corporate { border-left: 4px solid #6c757d; }
.theme-modern { border-left: 4px solid #667eea; }
.theme-minimal { border-left: 4px solid #f1f3f4; }
.theme-vibrant { border-left: 4px solid #ff6b6b; }
"))
),
titlePanel(
div(style = "text-align: center; margin-bottom: 30px;",
h1(bs_icon("palette"), "DT Styling Laboratory",
style = "background: linear-gradient(135deg, #6610f2 0%, #6f42c1 100%);
-webkit-background-clip: text; -webkit-text-fill-color: transparent;
font-weight: bold;"),
p("Professional table themes with reproducible R code and CSS",
class = "lead", style = "color: #6c757d;")
)
),
fluidRow(
column(4,
div(class = "styling-panel",
h4(bs_icon("brush"), "Professional Themes"),
# Original themes
div(class = "theme-card theme-corporate", id = "theme-corporate", onclick = "selectTheme('corporate')",
h5("Corporate Theme"),
p("Professional, clean design with subtle borders and business-appropriate colors"),
div(style = "height: 20px; background: linear-gradient(to right, #f8f9fa, #e9ecef);")
),
div(class = "theme-card theme-modern", id = "theme-modern", onclick = "selectTheme('modern')",
h5("Modern Theme"),
p("Sleek gradient backgrounds with bold colors and contemporary design"),
div(style = "height: 20px; background: linear-gradient(to right, #667eea, #764ba2);")
),
div(class = "theme-card theme-minimal", id = "theme-minimal", onclick = "selectTheme('minimal')",
h5("Minimal Theme"),
p("Clean, distraction-free design focused on maximum data readability"),
div(style = "height: 20px; background: linear-gradient(to right, #ffffff, #f1f3f4);")
),
div(class = "theme-card theme-vibrant", id = "theme-vibrant", onclick = "selectTheme('vibrant')",
h5("Vibrant Theme"),
p("Bold colors with high contrast for engaging, attention-grabbing displays"),
div(style = "height: 20px; background: linear-gradient(to right, #ff6b6b, #4ecdc4);")
),
# New professional themes
div(class = "theme-card theme-healthcare", id = "theme-healthcare", onclick = "selectTheme('healthcare')",
h5("Healthcare Theme"),
p("Medical-grade clarity with trust-building blues and clinical precision"),
div(style = "height: 20px; background: linear-gradient(to right, #28a745, #20c997);")
),
div(class = "theme-card theme-financial", id = "theme-financial", onclick = "selectTheme('financial')",
h5("Financial Theme"),
p("Banking-inspired design with professional blues and gold accents"),
div(style = "height: 20px; background: linear-gradient(to right, #007bff, #ffc107);")
),
div(class = "theme-card theme-scientific", id = "theme-scientific", onclick = "selectTheme('scientific')",
h5("Scientific Theme"),
p("Research-focused design with academic colors and precise typography"),
div(style = "height: 20px; background: linear-gradient(to right, #6f42c1, #e83e8c);")
)
),
div(class = "style-controls",
h5(bs_icon("sliders"), "Custom Styling"),
checkboxInput("enable_striping", "Row Striping", TRUE),
checkboxInput("enable_hover", "Hover Effects", TRUE),
checkboxInput("enable_borders", "Cell Borders", FALSE),
checkboxInput("compact_mode", "Compact Mode", FALSE),
hr(),
h6("Color Customization"),
colourpicker::colourInput("header_color", "Header Color:", "#f8f9fa"),
colourpicker::colourInput("stripe_color", "Stripe Color:", "#f8f9fa"),
colourpicker::colourInput("hover_color", "Hover Color:", "#e3f2fd"),
hr(),
h6("Conditional Formatting"),
checkboxInput("format_numbers", "Format Currency", TRUE),
checkboxInput("format_dates", "Format Dates", TRUE),
checkboxInput("color_coding", "Value-based Colors", TRUE)
)
),
column(8,
div(class = "preview-section",
h4(bs_icon("eye"), "Live Style Preview"),
p("See your styling choices applied in real-time with sample data:"),
DT::dataTableOutput("styled_table")
),
div(class = "preview-section",
h4(bs_icon("code-square"), "Generated Code & Downloads"),
div(class = "code-actions",
downloadButton("download_r", "Download R Script", class = "btn btn-primary download-btn"),
downloadButton("download_css", "Download CSS File", class = "btn btn-secondary download-btn"),
downloadButton("download_data", "Download Sample Data", class = "btn btn-success download-btn")
),
tabsetPanel(
tabPanel("Complete R Script",
verbatimTextOutput("complete_r_code")
),
tabPanel("Standalone Function",
verbatimTextOutput("function_code")
),
tabPanel("Custom CSS",
verbatimTextOutput("css_code")
),
tabPanel("Implementation Guide",
div(
h5("Quick Implementation Steps:"),
tags$ol(
tags$li("Copy the R code from the 'Complete R Script' tab"),
tags$li("Save it as a .R file and run to see your styled table"),
tags$li("Customize the sample data with your own dataset"),
tags$li("Download and include the CSS file for advanced styling"),
tags$li("Adjust colors and formatting options as needed")
),
div(class = "alert alert-info mt-3", style = "border-left: 4px solid #17a2b8; background-color: #d1ecf1; border-color: #b8daff;",
h6(tags$i(class = "bi bi-lightbulb-fill", style = "color: #0c5460;"), " Pro Tip: R Markdown Integration", style = "color: #0c5460; margin-bottom: 10px;"),
p("For professional reports, combine both R code and CSS in a single R Markdown document:", style = "margin-bottom: 8px;"),
tags$pre(style = "background: #f8f9fa; padding: 10px; border-radius: 4px; font-size: 12px; margin: 10px 0;",
code(
"---\n",
"title: \"Professional Data Analysis\"\n",
"output: html_document\n",
"---\n\n",
"```{css, echo=FALSE}\n",
"/* Paste CSS code from 'Custom CSS' tab here */\n",
"```\n\n",
"```{r setup, include=FALSE}\n",
"library(DT)\n",
"```\n\n",
"```{r}\n",
"# Paste R code from 'Complete R Script' tab here\n",
"```"
)
),
p(tags$strong("Benefits:"), " Self-contained document, professional HTML output, easy sharing, and reproducible analysis.",
style = "margin-bottom: 0; font-size: 14px; color: #495057;")
),
hr(),
h5("Professional Styling Guidelines:"),
tags$ul(
tags$li("Choose colors that align with your brand guidelines"),
tags$li("Maintain sufficient contrast for accessibility (4.5:1 ratio)"),
tags$li("Test responsive design on different screen sizes"),
tags$li("Use conditional formatting sparingly for maximum impact"),
tags$li("Consider your audience - clinical, financial, or scientific")
)
)
)
)
)
)
),
# JavaScript for theme selection
tags$script(HTML("
function selectTheme(theme) {
// Remove active class from all cards
document.querySelectorAll('.theme-card').forEach(card => {
card.classList.remove('active');
});
// Add active class to selected card
document.getElementById('theme-' + theme).classList.add('active');
// Trigger Shiny input
Shiny.setInputValue('selected_theme', theme);
}
// Initialize with corporate theme
document.addEventListener('DOMContentLoaded', function() {
selectTheme('corporate');
});
"))
)
server <- function(input, output, session) {
# Enhanced sample data with different data types for professional contexts
sample_data <- reactive({
theme <- input$selected_theme %||% "corporate"
# Different datasets based on theme
switch(theme,
"healthcare" = data.frame(
PatientID = sprintf("P%04d", 1:20),
Department = sample(c("Cardiology", "Neurology", "Oncology", "Emergency"), 20, replace = TRUE),
TreatmentCost = round(runif(20, 1000, 25000), 2),
StayDuration = sample(1:14, 20, replace = TRUE),
Discharged = sample(c(TRUE, FALSE), 20, replace = TRUE, prob = c(0.85, 0.15)),
Satisfaction = round(runif(20, 3.0, 5.0), 1),
AdmissionDate = sample(seq(as.Date("2024-01-01"), Sys.Date(), by = "day"), 20),
RiskScore = sample(1:10, 20, replace = TRUE),
stringsAsFactors = FALSE
),
"financial" = data.frame(
AccountID = sprintf("AC%06d", 1000001:1000020),
Portfolio = sample(c("Growth", "Value", "Balanced", "Conservative"), 20, replace = TRUE),
Investment = round(runif(20, 10000, 1000000), 2),
Returns = round(runif(20, -15, 25), 2),
Active = sample(c(TRUE, FALSE), 20, replace = TRUE, prob = c(0.9, 0.1)),
RiskLevel = round(runif(20, 1, 10), 1),
OpenDate = sample(seq(as.Date("2020-01-01"), Sys.Date(), by = "day"), 20),
Performance = sample(1:5, 20, replace = TRUE),
stringsAsFactors = FALSE
),
"scientific" = data.frame(
SampleID = sprintf("S%03d", 1:20),
Experiment = sample(c("Control", "Treatment A", "Treatment B", "Placebo"), 20, replace = TRUE),
Measurement = round(runif(20, 0.1, 100.5), 3),
PValue = round(runif(20, 0.001, 0.999), 4),
Significant = sample(c(TRUE, FALSE), 20, replace = TRUE, prob = c(0.3, 0.7)),
Confidence = round(runif(20, 85, 99.9), 1),
TestDate = sample(seq(as.Date("2024-01-01"), Sys.Date(), by = "day"), 20),
Quality = sample(1:5, 20, replace = TRUE),
stringsAsFactors = FALSE
),
# Default corporate/business data
data.frame(
ID = 1:20,
Product = paste("Product", LETTERS[1:20]),
Category = sample(c("Electronics", "Clothing", "Books", "Home"), 20, replace = TRUE),
Price = round(runif(20, 10, 500), 2),
InStock = sample(c(TRUE, FALSE), 20, replace = TRUE),
Rating = round(runif(20, 1, 5), 1),
LaunchDate = sample(seq(as.Date("2020-01-01"), Sys.Date(), by = "day"), 20),
Sales = sample(50:1000, 20),
stringsAsFactors = FALSE
)
)
})
# Create styled table based on selections
output$styled_table <- DT::renderDataTable({
data <- sample_data()
theme <- input$selected_theme %||% "corporate"
# Base table classes
table_classes <- c("display")
if(input$enable_striping) table_classes <- c(table_classes, "stripe")
if(input$enable_hover) table_classes <- c(table_classes, "hover")
if(input$enable_borders) table_classes <- c(table_classes, "cell-border")
if(input$compact_mode) table_classes <- c(table_classes, "compact")
# Create datatable
dt <- DT::datatable(
data,
options = list(
pageLength = 10,
searching = TRUE,
ordering = TRUE,
info = TRUE,
autoWidth = TRUE,
scrollX = TRUE,
# Custom styling based on theme
initComplete = DT::JS(paste0(
"function(settings, json) {",
" var theme = '", theme, "';",
" var headerColor = '", input$header_color %||% get_default_header_color(theme), "';",
" $('th').css('background-color', headerColor);",
" $('th').css('color', theme === 'modern' || theme === 'financial' || theme === 'scientific' ? 'white' : '#333');",
" $('th').css('font-weight', 'bold');",
get_theme_js(theme),
"}"
))
),
class = paste(table_classes, collapse = " "),
rownames = FALSE
)
# Apply formatting based on checkboxes and theme
if(input$format_numbers) {
numeric_cols <- get_numeric_columns(theme)
if(length(numeric_cols) > 0) {
for(col in numeric_cols) {
if(grepl("cost|price|investment", tolower(col))) {
dt <- dt %>% DT::formatCurrency(col, currency = "$")
} else {
dt <- dt %>% DT::formatRound(col, digits = get_precision_for_column(col, theme))
}
}
}
}
if(input$format_dates) {
date_cols <- get_date_columns(theme)
if(length(date_cols) > 0) {
for(col in date_cols) {
dt <- dt %>% DT::formatDate(col)
}
}
}
if(input$color_coding) {
dt <- apply_theme_color_coding(dt, data, theme)
}
# Apply custom striping and hover colors
if(input$enable_striping || input$enable_hover) {
stripe_color <- input$stripe_color %||% "#f8f9fa"
hover_color <- input$hover_color %||% "#e3f2fd"
session$sendCustomMessage("applyCustomColors", list(
stripe = stripe_color,
hover = hover_color,
enable_striping = input$enable_striping,
enable_hover = input$enable_hover
))
}
dt
})
# Generate complete R script with demo data
output$complete_r_code <- renderText({
theme <- input$selected_theme %||% "corporate"
code_lines <- c(
"# Complete DT Styling Example - Reproducible Script",
"# Generated by DT Styling Laboratory",
"",
"library(DT)",
"",
"# Sample data (replace with your own dataset)",
generate_data_code(theme),
"",
"# Create professionally styled data table",
"styled_table <- DT::datatable(",
" sample_data,",
"",
" # Styling options",
paste0(" class = \"", get_table_classes(), "\","),
"",
" options = list(",
" pageLength = 10,",
" searching = TRUE,",
" ordering = TRUE,",
" info = TRUE,",
" autoWidth = TRUE,",
" scrollX = TRUE,",
"",
" # Custom header styling",
" initComplete = DT::JS(",
" \"function(settings, json) {",
paste0(" $('th').css('background-color', '", input$header_color %||% get_default_header_color(theme), "');"),
paste0(" $('th').css('color', '", get_header_text_color(theme), "');"),
" $('th').css('font-weight', 'bold');",
get_theme_js(theme),
" }\"",
" )",
" ),",
"",
" rownames = FALSE",
")"
)
# Add formatting
if(input$format_numbers || input$format_dates || input$color_coding) {
code_lines <- c(code_lines, "", "# Apply professional formatting")
if(input$format_numbers) {
formatting_code <- generate_formatting_code(theme)
code_lines <- c(code_lines, formatting_code)
}
if(input$color_coding) {
color_code <- generate_color_coding_code(theme)
code_lines <- c(code_lines, color_code)
}
}
code_lines <- c(code_lines, "", "# Display the styled table", "styled_table")
paste(code_lines, collapse = "\n")
})
# Generate standalone function
output$function_code <- renderText({
theme <- input$selected_theme %||% "corporate"
function_lines <- c(
"# Reusable DT Styling Function",
paste0("style_datatable_", theme, " <- function(data) {"),
" ",
" # Apply professional styling",
" dt <- DT::datatable(",
" data,",
paste0(" class = \"", get_table_classes(), "\","),
" options = list(",
" pageLength = 10,",
" autoWidth = TRUE,",
" scrollX = TRUE,",
" initComplete = DT::JS(",
" \"function(settings, json) {",
paste0(" $('th').css('background-color', '", input$header_color %||% get_default_header_color(theme), "');"),
paste0(" $('th').css('color', '", get_header_text_color(theme), "');"),
" $('th').css('font-weight', 'bold');",
" }\"",
" )",
" ),",
" rownames = FALSE",
" )",
" ",
" return(dt)",
"}",
"",
"# Usage example:",
paste0("# my_styled_table <- style_datatable_", theme, "(your_data)")
)
paste(function_lines, collapse = "\n")
})
# Generate CSS code
output$css_code <- renderText({
theme <- input$selected_theme %||% "corporate"
css_lines <- c(
paste0("/* ", toupper(theme), " THEME - Custom DT Styling */"),
"/* Generated by DT Styling Laboratory */",
"",
".dataTables_wrapper {",
" font-family: 'Segoe UI', Tahoma, Geneva, Verdana, sans-serif;",
" font-size: 14px;",
"}",
""
)
if(input$enable_striping) {
stripe_color <- input$stripe_color %||% "#f8f9fa"
css_lines <- c(css_lines,
"/* Row striping */",
"table.dataTable.stripe tbody tr.odd {",
paste0(" background-color: ", stripe_color, ";"),
"}",
"")
}
if(input$enable_hover) {
hover_color <- input$hover_color %||% "#e3f2fd"
css_lines <- c(css_lines,
"/* Hover effects */",
"table.dataTable.hover tbody tr:hover {",
paste0(" background-color: ", hover_color, " !important;"),
" transition: background-color 0.3s ease;",
"}",
"")
}
# Theme-specific CSS
css_lines <- c(css_lines, get_theme_css(theme))
paste(css_lines, collapse = "\n")
})
# Download handlers
output$download_r <- downloadHandler(
filename = function() {
theme <- input$selected_theme %||% "corporate"
paste0("dt_styling_", theme, "_", Sys.Date(), ".R")
},
content = function(file) {
writeLines(output$complete_r_code(), file)
}
)
output$download_css <- downloadHandler(
filename = function() {
theme <- input$selected_theme %||% "corporate"
paste0("dt_styling_", theme, "_", Sys.Date(), ".css")
},
content = function(file) {
writeLines(output$css_code(), file)
}
)
output$download_data <- downloadHandler(
filename = function() {
paste0("sample_data_", Sys.Date(), ".csv")
},
content = function(file) {
write.csv(sample_data(), file, row.names = FALSE)
}
)
# Add custom message handler for dynamic CSS
observe({
session$sendCustomMessage("setupColorHandler", "")
})
# Helper functions
get_table_classes <- function() {
classes <- c("display")
if(input$enable_striping) classes <- c(classes, "stripe")
if(input$enable_hover) classes <- c(classes, "hover")
if(input$enable_borders) classes <- c(classes, "cell-border")
if(input$compact_mode) classes <- c(classes, "compact")
paste(classes, collapse = " ")
}
get_default_header_color <- function(theme) {
switch(theme,
"corporate" = "#f8f9fa",
"modern" = "#667eea",
"minimal" = "#ffffff",
"vibrant" = "#ff6b6b",
"healthcare" = "#28a745",
"financial" = "#007bff",
"scientific" = "#6f42c1")
}
get_header_text_color <- function(theme) {
switch(theme,
"corporate" = "#333",
"modern" = "white",
"minimal" = "#333",
"vibrant" = "white",
"healthcare" = "white",
"financial" = "white",
"scientific" = "white")
}
get_theme_color <- function(theme) {
switch(theme,
"corporate" = "#e9ecef",
"modern" = "#667eea",
"minimal" = "#f1f3f4",
"vibrant" = "#4ecdc4",
"healthcare" = "#20c997",
"financial" = "#ffc107",
"scientific" = "#e83e8c")
}
get_theme_js <- function(theme) {
switch(theme,
"corporate" = "$('table').css('border-collapse', 'collapse');",
"modern" = "$('table').css('background', 'linear-gradient(135deg, #f8f9fa, #e9ecef)');",
"minimal" = "$('table').css('border', 'none');",
"vibrant" = "$('th').css('background', 'linear-gradient(135deg, #ff6b6b, #4ecdc4)'); $('th').css('color', 'white');",
"healthcare" = "$('th').css('background', 'linear-gradient(135deg, #28a745, #20c997)'); $('th').css('color', 'white');",
"financial" = "$('th').css('background', 'linear-gradient(135deg, #007bff, #ffc107)'); $('th').css('color', 'white');",
"scientific" = "$('th').css('background', 'linear-gradient(135deg, #6f42c1, #e83e8c)'); $('th').css('color', 'white');")
}
get_theme_css <- function(theme) {
switch(theme,
"corporate" = c(
"/* Corporate theme - Professional and clean */",
"table.dataTable {",
" border-collapse: collapse;",
" border: 1px solid #dee2e6;",
" background: white;",
"}",
"",
"table.dataTable th {",
" border-bottom: 2px solid #dee2e6;",
" font-weight: 600;",
" text-transform: uppercase;",
" font-size: 12px;",
" letter-spacing: 0.5px;",
"}"
),
"modern" = c(
"/* Modern theme - Sleek gradients */",
"table.dataTable {",
" background: linear-gradient(135deg, #f8f9fa, #ffffff);",
" border-radius: 8px;",
" overflow: hidden;",
" box-shadow: 0 4px 6px rgba(0,0,0,0.1);",
"}",
"",
"table.dataTable th {",
" background: linear-gradient(135deg, #667eea, #764ba2);",
" color: white;",
" border: none;",
"}"
),
"minimal" = c(
"/* Minimal theme - Clean and simple */",
"table.dataTable {",
" border: none;",
" background: white;",
"}",
"",
"table.dataTable th {",
" border: none;",
" border-bottom: 1px solid #e0e0e0;",
" background: transparent;",
" font-weight: 500;",
"}"
),
"vibrant" = c(
"/* Vibrant theme - Bold and energetic */",
"table.dataTable th {",
" background: linear-gradient(135deg, #ff6b6b, #4ecdc4);",
" color: white;",
" font-weight: bold;",
" text-shadow: 0 1px 2px rgba(0,0,0,0.3);",
"}",
"",
"table.dataTable tbody tr {",
" transition: all 0.3s ease;",
"}",
"",
"table.dataTable tbody tr:hover {",
" transform: scale(1.02);",
"}"
),
"healthcare" = c(
"/* Healthcare theme - Trust and precision */",
"table.dataTable {",
" border: 2px solid #e3f2fd;",
" border-radius: 6px;",
" background: #fafafa;",
"}",
"",
"table.dataTable th {",
" background: linear-gradient(135deg, #28a745, #20c997);",
" color: white;",
" font-weight: 600;",
" border-bottom: 3px solid #1e7e34;",
"}",
"",
"table.dataTable tbody tr.odd {",
" background: #f8f9fa;",
"}",
"",
"table.dataTable tbody tr:hover {",
" background: #e8f5e9 !important;",
"}"
),
"financial" = c(
"/* Financial theme - Professional trust */",
"table.dataTable {",
" border: 1px solid #007bff;",
" background: linear-gradient(to bottom, #ffffff, #f8f9fa);",
"}",
"",
"table.dataTable th {",
" background: linear-gradient(135deg, #007bff, #0056b3);",
" color: white;",
" font-weight: 700;",
" border-bottom: 2px solid #ffc107;",
" text-transform: uppercase;",
" font-size: 11px;",
" letter-spacing: 1px;",
"}",
"",
"table.dataTable tbody tr {",
" border-bottom: 1px solid #e3f2fd;",
"}",
"",
"table.dataTable tbody tr:hover {",
" background: #e3f2fd !important;",
" border-left: 4px solid #007bff;",
"}"
),
"scientific" = c(
"/* Scientific theme - Academic precision */",
"table.dataTable {",
" border: 1px solid #6f42c1;",
" background: white;",
" font-family: 'Roboto Mono', monospace;",
"}",
"",
"table.dataTable th {",
" background: linear-gradient(135deg, #6f42c1, #e83e8c);",
" color: white;",
" font-weight: 600;",
" border-bottom: 2px solid #563d7c;",
" font-size: 12px;",
"}",
"",
"table.dataTable tbody tr {",
" border-bottom: 1px solid #f8f9fa;",
"}",
"",
"table.dataTable tbody tr:hover {",
" background: #f3e5f5 !important;",
" border-left: 3px solid #6f42c1;",
"}"
)
)
}
# Helper functions for data generation
generate_data_code <- function(theme) {
switch(theme,
"healthcare" = c(
"sample_data <- data.frame(",
" PatientID = sprintf('P%04d', 1:20),",
" Department = sample(c('Cardiology', 'Neurology', 'Oncology', 'Emergency'), 20, replace = TRUE),",
" TreatmentCost = round(runif(20, 1000, 25000), 2),",
" StayDuration = sample(1:14, 20, replace = TRUE),",
" Discharged = sample(c(TRUE, FALSE), 20, replace = TRUE, prob = c(0.85, 0.15)),",
" Satisfaction = round(runif(20, 3.0, 5.0), 1),",
" AdmissionDate = sample(seq(as.Date('2024-01-01'), Sys.Date(), by = 'day'), 20),",
" RiskScore = sample(1:10, 20, replace = TRUE),",
" stringsAsFactors = FALSE",
")"
),
"financial" = c(
"sample_data <- data.frame(",
" AccountID = sprintf('AC%06d', 1000001:1000020),",
" Portfolio = sample(c('Growth', 'Value', 'Balanced', 'Conservative'), 20, replace = TRUE),",
" Investment = round(runif(20, 10000, 1000000), 2),",
" Returns = round(runif(20, -15, 25), 2),",
" Active = sample(c(TRUE, FALSE), 20, replace = TRUE, prob = c(0.9, 0.1)),",
" RiskLevel = round(runif(20, 1, 10), 1),",
" OpenDate = sample(seq(as.Date('2020-01-01'), Sys.Date(), by = 'day'), 20),",
" Performance = sample(1:5, 20, replace = TRUE),",
" stringsAsFactors = FALSE",
")"
),
"scientific" = c(
"sample_data <- data.frame(",
" SampleID = sprintf('S%03d', 1:20),",
" Experiment = sample(c('Control', 'Treatment A', 'Treatment B', 'Placebo'), 20, replace = TRUE),",
" Measurement = round(runif(20, 0.1, 100.5), 3),",
" PValue = round(runif(20, 0.001, 0.999), 4),",
" Significant = sample(c(TRUE, FALSE), 20, replace = TRUE, prob = c(0.3, 0.7)),",
" Confidence = round(runif(20, 85, 99.9), 1),",
" TestDate = sample(seq(as.Date('2024-01-01'), Sys.Date(), by = 'day'), 20),",
" Quality = sample(1:5, 20, replace = TRUE),",
" stringsAsFactors = FALSE",
")"
),
# Default corporate data
c(
"sample_data <- data.frame(",
" ID = 1:20,",
" Product = paste('Product', LETTERS[1:20]),",
" Category = sample(c('Electronics', 'Clothing', 'Books', 'Home'), 20, replace = TRUE),",
" Price = round(runif(20, 10, 500), 2),",
" InStock = sample(c(TRUE, FALSE), 20, replace = TRUE),",
" Rating = round(runif(20, 1, 5), 1),",
" LaunchDate = sample(seq(as.Date('2020-01-01'), Sys.Date(), by = 'day'), 20),",
" Sales = sample(50:1000, 20),",
" stringsAsFactors = FALSE",
")"
)
)
}
get_numeric_columns <- function(theme) {
switch(theme,
"healthcare" = c("TreatmentCost", "StayDuration", "Satisfaction", "RiskScore"),
"financial" = c("Investment", "Returns", "RiskLevel", "Performance"),
"scientific" = c("Measurement", "PValue", "Confidence", "Quality"),
c("Price", "Rating", "Sales")) # Default
}
get_date_columns <- function(theme) {
switch(theme,
"healthcare" = "AdmissionDate",
"financial" = "OpenDate",
"scientific" = "TestDate",
"LaunchDate") # Default
}
get_precision_for_column <- function(col, theme) {
if(theme == "scientific" && col == "PValue") return(4)
if(theme == "scientific" && col == "Measurement") return(3)
if(grepl("satisfaction|rating|confidence", tolower(col))) return(1)
return(2)
}
apply_theme_color_coding <- function(dt, data, theme) {
switch(theme,
"healthcare" = {
dt %>%
DT::formatStyle("Discharged",
backgroundColor = DT::styleEqual(c(TRUE, FALSE), c("#d4edda", "#f8d7da")),
fontWeight = "bold") %>%
DT::formatStyle("RiskScore",
backgroundColor = DT::styleInterval(
cuts = c(3, 6, 8),
values = c("#d4edda", "#fff3cd", "#f8d7da", "#f5c6cb"))) %>%
DT::formatStyle("StayDuration",
background = DT::styleColorBar(range(data$StayDuration),
get_theme_color(theme)),
backgroundSize = "100% 90%",
backgroundRepeat = "no-repeat",
backgroundPosition = "center")
},
"financial" = {
dt %>%
DT::formatStyle("Active",
backgroundColor = DT::styleEqual(c(TRUE, FALSE), c("#d1ecf1", "#f8d7da")),
fontWeight = "bold") %>%
DT::formatStyle("Returns",
backgroundColor = DT::styleInterval(
cuts = c(0, 10),
values = c("#f8d7da", "#fff3cd", "#d4edda"))) %>%
DT::formatStyle("Performance",
background = DT::styleColorBar(range(data$Performance),
get_theme_color(theme)),
backgroundSize = "100% 90%",
backgroundRepeat = "no-repeat",
backgroundPosition = "center")
},
"scientific" = {
dt %>%
DT::formatStyle("Significant",
backgroundColor = DT::styleEqual(c(TRUE, FALSE), c("#d4edda", "#f8d7da")),
fontWeight = "bold") %>%
DT::formatStyle("PValue",
backgroundColor = DT::styleInterval(
cuts = c(0.01, 0.05),
values = c("#d4edda", "#fff3cd", "#f8d7da"))) %>%
DT::formatStyle("Quality",
background = DT::styleColorBar(range(data$Quality),
get_theme_color(theme)),
backgroundSize = "100% 90%",
backgroundRepeat = "no-repeat",
backgroundPosition = "center")
},
# Default styling
{
dt %>%
DT::formatStyle("InStock",
backgroundColor = DT::styleEqual(c(TRUE, FALSE), c("lightgreen", "lightcoral")),
fontWeight = "bold") %>%
DT::formatStyle("Rating",
backgroundColor = DT::styleInterval(
cuts = c(2, 3, 4),
values = c("#ffebee", "#fff3e0", "#e8f5e8", "#e3f2fd"))) %>%
DT::formatStyle("Sales",
background = DT::styleColorBar(range(data$Sales),
get_theme_color(theme)),
backgroundSize = "100% 90%",
backgroundRepeat = "no-repeat",
backgroundPosition = "center")
}
)
}
generate_formatting_code <- function(theme) {
numeric_cols <- get_numeric_columns(theme)
formatting_lines <- c()
for(col in numeric_cols) {
if(grepl("cost|price|investment", tolower(col))) {
formatting_lines <- c(formatting_lines, paste0("styled_table <- styled_table %>% DT::formatCurrency('", col, "', currency = '$')"))
} else {
precision <- get_precision_for_column(col, theme)
formatting_lines <- c(formatting_lines, paste0("styled_table <- styled_table %>% DT::formatRound('", col, "', digits = ", precision, ")"))
}
}
return(formatting_lines)
}
generate_color_coding_code <- function(theme) {
switch(theme,
"healthcare" = c(
"# Healthcare-specific color coding",
"styled_table <- styled_table %>%",
" DT::formatStyle('Discharged',",
" backgroundColor = DT::styleEqual(c(TRUE, FALSE), c('#d4edda', '#f8d7da')),",
" fontWeight = 'bold') %>%",
" DT::formatStyle('RiskScore',",
" backgroundColor = DT::styleInterval(c(3, 6, 8), c('#d4edda', '#fff3cd', '#f8d7da', '#f5c6cb'))) %>%",
" DT::formatStyle('StayDuration',",
" background = DT::styleColorBar(range(sample_data$StayDuration), '#20c997'),",
" backgroundSize = '100% 90%', backgroundRepeat = 'no-repeat', backgroundPosition = 'center')"
),
"financial" = c(
"# Financial-specific color coding",
"styled_table <- styled_table %>%",
" DT::formatStyle('Active',",
" backgroundColor = DT::styleEqual(c(TRUE, FALSE), c('#d1ecf1', '#f8d7da')),",
" fontWeight = 'bold') %>%",
" DT::formatStyle('Returns',",
" backgroundColor = DT::styleInterval(c(0, 10), c('#f8d7da', '#fff3cd', '#d4edda'))) %>%",
" DT::formatStyle('Performance',",
" background = DT::styleColorBar(range(sample_data$Performance), '#ffc107'),",
" backgroundSize = '100% 90%', backgroundRepeat = 'no-repeat', backgroundPosition = 'center')"
),
"scientific" = c(
"# Scientific-specific color coding",
"styled_table <- styled_table %>%",
" DT::formatStyle('Significant',",
" backgroundColor = DT::styleEqual(c(TRUE, FALSE), c('#d4edda', '#f8d7da')),",
" fontWeight = 'bold') %>%",
" DT::formatStyle('PValue',",
" backgroundColor = DT::styleInterval(c(0.01, 0.05), c('#d4edda', '#fff3cd', '#f8d7da'))) %>%",
" DT::formatStyle('Quality',",
" background = DT::styleColorBar(range(sample_data$Quality), '#e83e8c'),",
" backgroundSize = '100% 90%', backgroundRepeat = 'no-repeat', backgroundPosition = 'center')"
),
c(
"# Standard color coding with bar plots",
"styled_table <- styled_table %>%",
" DT::formatStyle('InStock',",
" backgroundColor = DT::styleEqual(c(TRUE, FALSE), c('lightgreen', 'lightcoral')),",
" fontWeight = 'bold') %>%",
" DT::formatStyle('Rating',",
" backgroundColor = DT::styleInterval(c(2, 3, 4), c('#ffebee', '#fff3e0', '#e8f5e8', '#e3f2fd'))) %>%",
" DT::formatStyle('Sales',",
" background = DT::styleColorBar(range(sample_data$Sales), '#4ecdc4'),",
" backgroundSize = '100% 90%', backgroundRepeat = 'no-repeat', backgroundPosition = 'center')"
)
)
}
}
# Custom JavaScript for dynamic color changes
tags$script(HTML("
Shiny.addCustomMessageHandler('applyCustomColors', function(colors) {
var style = document.getElementById('dynamic-colors');
if (!style) {
style = document.createElement('style');
style.id = 'dynamic-colors';
document.head.appendChild(style);
}
var css = '';
if (colors.enable_striping) {
css += 'table.dataTable.stripe tbody tr.odd { background-color: ' + colors.stripe + '; }';
}
if (colors.enable_hover) {
css += 'table.dataTable.hover tbody tr:hover { background-color: ' + colors.hover + ' !important; transition: background-color 0.3s ease; }';
}
style.innerHTML = css;
});
Shiny.addCustomMessageHandler('setupColorHandler', function(data) {
// Handler is ready
});
"))
shinyApp(ui = ui, server = server)
Advanced Integration Patterns
Dynamic Column Management
Create applications where users can control table structure and content dynamically:
server <- function(input, output, session) {
# Sample dataset with many columns
full_dataset <- reactive({
data.frame(
ID = 1:50,
FirstName = randomNames::randomNames(50, which.names = "first"),
LastName = randomNames::randomNames(50, which.names = "last"),
Age = sample(18:65, 50, replace = TRUE),
Department = sample(c("Engineering", "Marketing", "Sales", "HR"), 50, replace = TRUE),
Salary = round(runif(50, 40000, 120000), 0),
StartDate = sample(seq(as.Date("2020-01-01"), Sys.Date(), by = "day"), 50),
Performance = round(runif(50, 1, 5), 1),
Active = sample(c(TRUE, FALSE), 50, replace = TRUE, prob = c(0.8, 0.2)),
Email = paste0(tolower(paste0(substr(randomNames::randomNames(50, which.names = "first"), 1, 1),
randomNames::randomNames(50, which.names = "last"))), "@company.com"),
Phone = paste0("(", sample(200:999, 50, replace = TRUE), ") ",
sample(200:999, 50, replace = TRUE), "-",
sample(1000:9999, 50, replace = TRUE)),
Notes = paste("Employee note", sample(1:100, 50, replace = TRUE)),
stringsAsFactors = FALSE
)
})
# Reactive filtered dataset based on column selection
filtered_dataset <- reactive({
req(input$selected_columns)
data <- full_dataset()
selected_cols <- input$selected_columns
# Always include ID for reference
if(!"ID" %in% selected_cols) {
selected_cols <- c("ID", selected_cols)
}
data[, selected_cols, drop = FALSE]
})
# Dynamic column selection UI
output$column_selector <- renderUI({
all_columns <- names(full_dataset())
checkboxGroupInput(
"selected_columns",
"Select Columns to Display:",
choices = setNames(all_columns, all_columns),
selected = c("ID", "FirstName", "LastName", "Department", "Salary"),
inline = FALSE
)
})
# Dynamic table with selected columns
output$dynamic_columns_table <- DT::renderDataTable({
req(filtered_dataset())
data <- filtered_dataset()
# Create table with dynamic formatting
dt <- DT::datatable(
data,
options = list(
pageLength = 15,
scrollX = TRUE,
autoWidth = TRUE,
dom = 'Blfrtip',
buttons = c('copy', 'csv', 'excel', 'colvis'),
# Dynamic column definitions
columnDefs = create_dynamic_column_defs(names(data))
),
extensions = c('Buttons', 'ColReorder'),
filter = 'top',
selection = 'multiple'
)
# Apply dynamic formatting based on available columns
dt <- apply_dynamic_formatting(dt, data)
return(dt)
})
# Helper function for dynamic column definitions
create_dynamic_column_defs <- function(column_names) {
col_defs <- list()
for(i in seq_along(column_names)) {
col_name <- column_names[i]
if(col_name == "ID") {
col_defs[[length(col_defs) + 1]] <- list(
targets = i - 1,
width = "60px",
className = "dt-center"
)
} else if(col_name %in% c("Salary")) {
col_defs[[length(col_defs) + 1]] <- list(
targets = i - 1,
className = "dt-right"
)
} else if(col_name %in% c("Active")) {
col_defs[[length(col_defs) + 1]] <- list(
targets = i - 1,
className = "dt-center",
width = "80px"
)
}
}
return(col_defs)
}
# Helper function for dynamic formatting
apply_dynamic_formatting <- function(dt, data) {
column_names <- names(data)
# Format currency columns
if("Salary" %in% column_names) {
dt <- dt %>% DT::formatCurrency("Salary", currency = "$", digits = 0)
}
# Format date columns
if("StartDate" %in% column_names) {
dt <- dt %>% DT::formatDate("StartDate")
}
# Format percentage columns
if("Performance" %in% column_names) {
dt <- dt %>%
DT::formatRound("Performance", digits = 1) %>%
DT::formatStyle(
"Performance",
backgroundColor = DT::styleInterval(
cuts = c(2, 3, 4),
values = c("lightcoral", "lightyellow", "lightblue", "lightgreen")
)
)
}
# Format boolean columns
if("Active" %in% column_names) {
dt <- dt %>%
DT::formatStyle(
"Active",
backgroundColor = DT::styleEqual(
c(TRUE, FALSE),
c("lightgreen", "lightcoral")
),
fontWeight = "bold"
)
}
return(dt)
}
# Summary statistics for visible columns
output$column_summary <- renderUI({
req(filtered_dataset())
data <- filtered_dataset()
summary_cards <- list()
for(col_name in names(data)) {
if(is.numeric(data[[col_name]])) {
card_content <- div(
class = "panel panel-info",
div(class = "panel-heading", h5(col_name)),
div(class = "panel-body",
p(paste("Mean:", round(mean(data[[col_name]], na.rm = TRUE), 2))),
p(paste("Median:", round(median(data[[col_name]], na.rm = TRUE), 2))),
p(paste("Range:", paste(range(data[[col_name]], na.rm = TRUE), collapse = " - ")))
)
)
} else if(is.logical(data[[col_name]])) {
true_count <- sum(data[[col_name]], na.rm = TRUE)
total_count <- length(data[[col_name]])
card_content <- div(
class = "panel panel-success",
div(class = "panel-heading", h5(col_name)),
div(class = "panel-body",
p(paste("True:", true_count)),
p(paste("False:", total_count - true_count)),
p(paste("Percentage:", round(true_count / total_count * 100, 1), "%"))
)
)
} else {
unique_count <- length(unique(data[[col_name]]))
card_content <- div(
class = "panel panel-warning",
div(class = "panel-heading", h5(col_name)),
div(class = "panel-body",
p(paste("Unique values:", unique_count)),
p(paste("Most common:", names(sort(table(data[[col_name]]), decreasing = TRUE))[1]))
)
)
}
summary_cards[[col_name]] <- column(4, card_content)
}
do.call(fluidRow, summary_cards[1:min(3, length(summary_cards))])
})
}Real-Time Data Integration
Connect tables to live data sources for dynamic, up-to-date displays:
server <- function(input, output, session) {
# Simulated real-time data source
live_data <- reactiveVal({
data.frame(
ID = 1:20,
Timestamp = Sys.time() - runif(20, 0, 3600),
Sensor = paste("Sensor", sample(1:5, 20, replace = TRUE)),
Value = round(runif(20, 0, 100), 2),
Status = sample(c("Normal", "Warning", "Critical"), 20, replace = TRUE, prob = c(0.7, 0.2, 0.1)),
Location = sample(c("Building A", "Building B", "Building C"), 20, replace = TRUE),
stringsAsFactors = FALSE
)
})
# Update data every 5 seconds
observe({
invalidateLater(5000) # 5 seconds
# Simulate new data arrival
new_data <- data.frame(
ID = max(live_data()$ID) + 1,
Timestamp = Sys.time(),
Sensor = paste("Sensor", sample(1:5, 1)),
Value = round(runif(1, 0, 100), 2),
Status = sample(c("Normal", "Warning", "Critical"), 1, prob = c(0.7, 0.2, 0.1)),
Location = sample(c("Building A", "Building B", "Building C"), 1),
stringsAsFactors = FALSE
)
# Add new data and keep only last 50 records
updated_data <- rbind(live_data(), new_data)
if(nrow(updated_data) > 50) {
updated_data <- tail(updated_data, 50)
}
live_data(updated_data)
})
# Real-time table with automatic updates
output$realtime_table <- DT::renderDataTable({
data <- live_data()
DT::datatable(
data,
options = list(
pageLength = 15,
searching = TRUE,
ordering = TRUE,
order = list(list(1, 'desc')), # Order by timestamp descending
# Auto-refresh configuration
serverSide = FALSE,
processing = FALSE,
# Styling
dom = 'frtip',
scrollX = TRUE,
# Row callback for real-time highlighting
rowCallback = DT::JS(
"function(row, data, index) {",
" var timestamp = new Date(data[1]);",
" var now = new Date();",
" var diff = (now - timestamp) / 1000;", # Difference in seconds
" if(diff < 30) {",
" $(row).addClass('new-data');",
" }",
" if(data[4] === 'Critical') {",
" $(row).addClass('critical-status');",
" }",
"}"
)
),
selection = 'single',
filter = 'top'
) %>%
# Format timestamp
DT::formatDate("Timestamp", method = "toLocaleString") %>%
# Format value with color bar
DT::formatStyle(
"Value",
background = DT::styleColorBar(c(0, 100), 'lightblue'),
backgroundSize = '100% 90%',
backgroundRepeat = 'no-repeat',
backgroundPosition = 'center'
) %>%
# Status-based formatting
DT::formatStyle(
"Status",
backgroundColor = DT::styleEqual(
c("Normal", "Warning", "Critical"),
c("lightgreen", "lightyellow", "lightcoral")
),
fontWeight = DT::styleEqual("Critical", "bold")
)
})
# Real-time summary statistics
output$realtime_summary <- renderUI({
data <- live_data()
# Calculate summary statistics
total_sensors <- length(unique(data$Sensor))
avg_value <- round(mean(data$Value), 2)
critical_count <- sum(data$Status == "Critical")
warning_count <- sum(data$Status == "Warning")
# Recent data (last 5 minutes)
recent_data <- data[data$Timestamp > (Sys.time() - 300), ]
recent_count <- nrow(recent_data)
div(
class = "row",
column(3,
div(class = "panel panel-primary",
div(class = "panel-body text-center",
h3(total_sensors),
p("Active Sensors")
)
)
),
column(3,
div(class = "panel panel-info",
div(class = "panel-body text-center",
h3(avg_value),
p("Average Value")
)
)
),
column(3,
div(class = "panel panel-warning",
div(class = "panel-body text-center",
h3(warning_count),
p("Warnings")
)
)
),
column(3,
div(class = "panel panel-danger",
div(class = "panel-body text-center",
h3(critical_count),
p("Critical Alerts")
)
)
)
)
})
# Alert system for critical values
observe({
data <- live_data()
current_critical <- data[data$Status == "Critical", ]
if(nrow(current_critical) > 0) {
# Check for new critical alerts
latest_critical <- current_critical[current_critical$Timestamp > (Sys.time() - 10), ]
if(nrow(latest_critical) > 0) {
for(i in seq_len(nrow(latest_critical))) {
alert <- latest_critical[i, ]
showNotification(
paste("CRITICAL ALERT:", alert$Sensor, "at", alert$Location,
"- Value:", alert$Value),
type = "error",
duration = 10
)
}
}
}
})
}
# CSS for real-time table styling
realtime_table_css <- "
.new-data {
background-color: #e8f5e8 !important;
border-left: 4px solid #28a745;
animation: highlight 2s ease-in-out;
}
.critical-status {
background-color: #f8d7da !important;
border-left: 4px solid #dc3545;
font-weight: bold;
}
@keyframes highlight {
0% { background-color: #90EE90; }
100% { background-color: #e8f5e8; }
}
.dataTables_wrapper .dataTables_info {
font-size: 0.9em;
color: #6c757d;
}
"Common Data Table Issues and Solutions
Issue 1: Performance with Large Datasets
Problem: Tables become slow and unresponsive with datasets containing thousands of rows.
Solution:
# Implement server-side processing with pagination
optimize_large_table <- function(data) {
DT::datatable(
data,
options = list(
# Enable server-side processing
serverSide = TRUE,
processing = TRUE,
# Optimize rendering
deferRender = TRUE,
scroller = TRUE,
scrollY = "400px",
# Limit initial load
pageLength = 25,
lengthMenu = c(10, 25, 50, 100),
# Disable features that slow down large datasets
searching = TRUE,
ordering = TRUE,
info = TRUE,
# Performance optimizations
dom = 'lfrtp', # Remove buttons initially
stateSave = FALSE # Disable state saving for large datasets
),
extensions = c('Scroller'),
filter = 'none' # Disable column filters for better performance
)
}
# Alternative: Virtual scrolling for client-side processing
implement_virtual_scrolling <- function(data) {
DT::datatable(
data,
options = list(
scrollY = "400px",
scrollCollapse = TRUE,
scroller = TRUE,
deferRender = TRUE,
dom = 'frtp',
pageLength = -1 # Show all rows with virtual scrolling
),
extensions = 'Scroller'
)
}Performance Optimization Laboratory
Understanding when to use client-side versus server-side processing is crucial for creating responsive applications. The decision isn’t just about data size—it involves user interaction patterns, network conditions, and performance expectations.
Interactive Demo: Master Performance Optimization
Compare processing methods with real metrics:
- Test different data sizes - See how performance changes from 1K to 100K rows
- Compare processing modes - Switch between client-side and server-side processing instantly
- Monitor real metrics - Track render time, memory usage, data transfer, and responsiveness scores
- Get recommendations - Receive specific guidance based on your configuration and results
- Understand trade-offs - Learn when each approach provides the best user experience
Key Learning: Make informed decisions about table performance optimization based on real data and metrics rather than assumptions.
#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| components: [viewer]
#| viewerHeight: 1500
library(shiny)
library(bslib)
library(bsicons)
library(DT)
ui <- fluidPage(
theme = bs_theme(version = 5, bootswatch = "cosmo"),
tags$head(
tags$style(HTML("
.performance-panel {
background: linear-gradient(135deg, #28a745 0%, #20c997 100%);
color: white;
border-radius: 12px;
padding: 20px;
margin-bottom: 20px;
box-shadow: 0 8px 32px rgba(0,0,0,0.1);
}
.benchmark-card {
background: white;
border-radius: 8px;
padding: 20px;
margin: 10px 0;
box-shadow: 0 4px 15px rgba(0,0,0,0.1);
position: relative;
overflow: hidden;
}
.benchmark-card::before {
content: '';
position: absolute;
top: 0;
left: 0;
right: 0;
height: 4px;
background: linear-gradient(135deg, #28a745, #20c997);
}
.metric-display {
text-align: center;
padding: 15px;
background: #f8f9fa;
border-radius: 8px;
margin: 10px 0;
}
.metric-value {
font-size: 2rem;
font-weight: bold;
color: #28a745;
}
.metric-label {
color: #6c757d;
font-size: 0.9rem;
}
.processing-indicator {
display: none;
text-align: center;
padding: 20px;
color: #6c757d;
}
.processing-indicator.active {
display: block;
}
.comparison-table {
background: white;
border-radius: 8px;
padding: 15px;
margin: 10px 0;
box-shadow: 0 2px 10px rgba(0,0,0,0.1);
}
.winner-badge {
background: #28a745;
color: white;
padding: 4px 12px;
border-radius: 20px;
font-size: 0.8rem;
font-weight: bold;
}
.performance-bar {
height: 20px;
background: #e9ecef;
border-radius: 10px;
overflow: hidden;
margin: 5px 0;
}
.performance-fill {
height: 100%;
background: linear-gradient(135deg, #28a745, #20c997);
transition: width 1s ease;
}
"))
),
titlePanel(
div(style = "text-align: center; margin-bottom: 30px;",
h1(bs_icon("speedometer2"), "DT Performance Laboratory",
style = "background: linear-gradient(135deg, #28a745 0%, #20c997 100%);
-webkit-background-clip: text; -webkit-text-fill-color: transparent;
font-weight: bold;"),
p("Compare client-side vs server-side processing performance with real metrics",
class = "lead", style = "color: #6c757d;")
)
),
div(class = "performance-panel",
h4(bs_icon("graph-up"), "Performance Testing Dashboard"),
p("Test different data sizes and processing methods to understand performance trade-offs"),
fluidRow(
column(4,
selectInput("dataset_size", "Dataset Size:",
choices = c("Small (1K rows)" = 1000,
"Medium (10K rows)" = 10000,
"Large (50K rows)" = 50000,
"Extra Large (100K rows)" = 100000),
selected = 10000)
),
column(4,
radioButtons("processing_mode", "Processing Mode:",
choices = c("Client-Side" = "client",
"Server-Side" = "server"),
selected = "client", inline = TRUE)
),
column(4,
actionButton("run_benchmark", "Run Performance Test",
class = "btn-warning btn-block", style = "margin-top: 25px;")
)
)
),
fluidRow(
column(6,
div(class = "benchmark-card",
h4(bs_icon("clock"), "Performance Metrics"),
div(class = "processing-indicator", id = "processing",
bs_icon("arrow-clockwise", class = "fa-spin"),
" Running benchmark..."
),
div(id = "metrics-display",
fluidRow(
column(6,
div(class = "metric-display",
div(class = "metric-value", textOutput("render_time", container = span)),
div(class = "metric-label", "Render Time (ms)")
)
),
column(6,
div(class = "metric-display",
div(class = "metric-value", textOutput("memory_usage", container = span)),
div(class = "metric-label", "Memory Usage (MB)")
)
)
),
fluidRow(
column(6,
div(class = "metric-display",
div(class = "metric-value", textOutput("data_size", container = span)),
div(class = "metric-label", "Data Transfer (KB)")
)
),
column(6,
div(class = "metric-display",
div(class = "metric-value", textOutput("responsiveness", container = span)),
div(class = "metric-label", "Responsiveness Score")
)
)
)
)
),
div(class = "comparison-table",
h5(bs_icon("bar-chart"), "Performance Comparison"),
DT::dataTableOutput("comparison_table")
)
),
column(6,
div(class = "benchmark-card",
h4(bs_icon("table"), "Benchmark Table"),
p("The actual table being tested:"),
div(style = "max-height: 500px; overflow-y: auto;",
DT::dataTableOutput("benchmark_table")
)
),
div(class = "benchmark-card",
h4(bs_icon("lightbulb"), "Performance Recommendations"),
div(id = "recommendations",
uiOutput("performance_recommendations")
)
)
)
)
)
server <- function(input, output, session) {
# Reactive values for tracking performance
performance_data <- reactiveValues(
render_time = 0,
memory_usage = 0,
data_size = 0,
responsiveness = 0,
history = data.frame()
)
# Generate test dataset
test_dataset <- reactive({
size <- as.numeric(input$dataset_size)
data.frame(
ID = 1:size,
Name = paste("Item", 1:size),
Category = sample(c("Electronics", "Clothing", "Books", "Home", "Sports"), size, replace = TRUE),
Price = round(runif(size, 10, 1000), 2),
InStock = sample(c(TRUE, FALSE), size, replace = TRUE),
Rating = round(runif(size, 1, 5), 1),
Sales = sample(1:10000, size, replace = TRUE),
Date = sample(seq(as.Date("2020-01-01"), Sys.Date(), by = "day"), size, replace = TRUE),
Region = sample(c("North", "South", "East", "West", "Central"), size, replace = TRUE),
Supplier = paste("Supplier", sample(1:100, size, replace = TRUE)),
stringsAsFactors = FALSE
)
})
# Benchmark table with performance measurement
output$benchmark_table <- DT::renderDataTable({
# Only render when benchmark is triggered
input$run_benchmark
isolate({
start_time <- Sys.time()
start_memory <- as.numeric(pryr::mem_used()) / 1024^2 # Convert to MB
data <- test_dataset()
mode <- input$processing_mode
# Configure table based on processing mode
if(mode == "client") {
dt <- DT::datatable(
data,
options = list(
pageLength = 25,
lengthMenu = c(10, 25, 50, 100),
searching = TRUE,
ordering = TRUE,
info = TRUE,
processing = FALSE,
serverSide = FALSE,
scrollX = TRUE,
autoWidth = TRUE
),
filter = 'top',
selection = 'multiple'
)
} else {
dt <- DT::datatable(
data,
options = list(
pageLength = 25,
lengthMenu = c(10, 25, 50, 100),
searching = TRUE,
ordering = TRUE,
info = TRUE,
processing = TRUE,
serverSide = TRUE,
scrollX = TRUE,
autoWidth = TRUE,
deferRender = TRUE
),
filter = 'top',
selection = 'multiple'
)
}
# Calculate performance metrics
end_time <- Sys.time()
end_memory <- as.numeric(pryr::mem_used()) / 1024^2
render_time <- round(as.numeric(difftime(end_time, start_time, units = "secs")) * 1000, 2)
memory_diff <- round(end_memory - start_memory, 2)
data_size_kb <- round(object.size(data) / 1024, 2)
# Calculate responsiveness score (higher is better)
responsiveness <- round(100 - (render_time / 10 + memory_diff), 1)
responsiveness <- max(0, min(100, responsiveness))
# Update performance data
performance_data$render_time <- render_time
performance_data$memory_usage <- memory_diff
performance_data$data_size <- data_size_kb
performance_data$responsiveness <- responsiveness
# Add to history
new_row <- data.frame(
Timestamp = Sys.time(),
Mode = mode,
DataSize = input$dataset_size,
RenderTime = render_time,
Memory = memory_diff,
DataTransfer = data_size_kb,
Responsiveness = responsiveness,
stringsAsFactors = FALSE
)
if(nrow(performance_data$history) == 0) {
performance_data$history <- new_row
} else {
performance_data$history <- rbind(performance_data$history, new_row)
# Keep only last 20 results
if(nrow(performance_data$history) > 20) {
performance_data$history <- tail(performance_data$history, 20)
}
}
dt
})
})
# Performance metrics outputs
output$render_time <- renderText({
paste0(performance_data$render_time, " ms")
})
output$memory_usage <- renderText({
paste0(performance_data$memory_usage, " MB")
})
output$data_size <- renderText({
paste0(performance_data$data_size, " KB")
})
output$responsiveness <- renderText({
score <- performance_data$responsiveness
paste0(score, "/100")
})
# Comparison table
output$comparison_table <- DT::renderDataTable({
req(nrow(performance_data$history) > 0)
history <- performance_data$history
# Create summary by mode
if(nrow(history) > 1) {
summary_data <- aggregate(
cbind(RenderTime, Memory, Responsiveness) ~ Mode,
data = history,
FUN = function(x) round(mean(x, na.rm = TRUE), 2)
)
summary_data$Winner <- ""
# Determine winners (lower is better for render time and memory)
if(nrow(summary_data) == 2) {
client_idx <- which(summary_data$Mode == "client")
server_idx <- which(summary_data$Mode == "server")
if(length(client_idx) > 0 && length(server_idx) > 0) {
# Render time winner
if(summary_data$RenderTime[client_idx] < summary_data$RenderTime[server_idx]) {
summary_data$Winner[client_idx] <- "Faster Rendering"
} else {
summary_data$Winner[server_idx] <- "Faster Rendering"
}
# Add memory winner if significantly different
if(abs(summary_data$Memory[client_idx] - summary_data$Memory[server_idx]) > 1) {
memory_winner_idx <- if(summary_data$Memory[client_idx] < summary_data$Memory[server_idx]) client_idx else server_idx
current_winner <- summary_data$Winner[memory_winner_idx]
summary_data$Winner[memory_winner_idx] <- if(nchar(current_winner) > 0) paste(current_winner, "+ Lower Memory") else "Lower Memory"
}
}
}
colnames(summary_data) <- c("Processing Mode", "Avg Render Time (ms)", "Avg Memory (MB)", "Avg Responsiveness", "Performance Winner")
} else {
summary_data <- data.frame(
"Processing Mode" = history$Mode[nrow(history)],
"Render Time (ms)" = history$RenderTime[nrow(history)],
"Memory (MB)" = history$Memory[nrow(history)],
"Responsiveness" = history$Responsiveness[nrow(history)],
"Status" = "Single Test",
check.names = FALSE,
stringsAsFactors = FALSE
)
}
DT::datatable(
summary_data,
options = list(
pageLength = 5,
searching = FALSE,
ordering = FALSE,
info = FALSE,
paging = FALSE,
dom = "t"
),
rownames = FALSE
) %>%
DT::formatStyle(
columns = ncol(summary_data),
backgroundColor = DT::styleEqual("", "white", default = "#e8f5e8"),
fontWeight = DT::styleEqual("", "normal", default = "bold")
)
})
# Performance recommendations
output$performance_recommendations <- renderUI({
render_time <- performance_data$render_time
memory_usage <- performance_data$memory_usage
data_size <- as.numeric(input$dataset_size)
mode <- input$processing_mode
recommendations <- list()
# Render time recommendations
if(render_time > 2000) { # > 2 seconds
recommendations <- append(recommendations, list(
div(class = "alert alert-warning",
bs_icon("exclamation-triangle"), " ",
strong("Slow rendering detected: "),
"Consider server-side processing for datasets over 10,000 rows"
)
))
}
# Memory recommendations
if(memory_usage > 50) { # > 50MB
recommendations <- append(recommendations, list(
div(class = "alert alert-danger",
bs_icon("memory"), " ",
strong("High memory usage: "),
"Enable server-side processing to reduce client memory consumption"
)
))
}
# Data size recommendations
if(data_size > 10000 && mode == "client") {
recommendations <- append(recommendations, list(
div(class = "alert alert-info",
bs_icon("database"), " ",
strong("Large dataset detected: "),
"Server-side processing recommended for better performance"
)
))
}
# Positive feedback
if(render_time < 500 && memory_usage < 10) {
recommendations <- append(recommendations, list(
div(class = "alert alert-success",
bs_icon("check-circle"), " ",
strong("Excellent performance: "),
"Current configuration is optimal for this dataset size"
)
))
}
# Mode-specific recommendations
if(mode == "client" && data_size > 50000) {
recommendations <- append(recommendations, list(
div(class = "alert alert-warning",
bs_icon("lightning"), " ",
strong("Client-side limitation: "),
"Consider pagination, filtering, or server-side processing for large datasets"
)
))
}
if(mode == "server" && data_size < 1000) {
recommendations <- append(recommendations, list(
div(class = "alert alert-info",
bs_icon("info-circle"), " ",
strong("Optimization opportunity: "),
"Client-side processing may be more responsive for small datasets"
)
))
}
# General best practices
recommendations <- append(recommendations, list(
div(class = "alert alert-light",
h6(bs_icon("lightbulb"), " Best Practices:"),
tags$ul(
tags$li("Use client-side processing for datasets < 10,000 rows"),
tags$li("Use server-side processing for datasets > 10,000 rows"),
tags$li("Enable deferred rendering for large datasets"),
tags$li("Consider virtual scrolling for read-heavy applications"),
tags$li("Implement pagination for better user experience")
)
)
))
if(length(recommendations) == 0) {
recommendations <- list(
div(class = "alert alert-secondary",
bs_icon("graph-up"), " ",
"Run a benchmark test to see performance recommendations"
)
)
}
do.call(tagList, recommendations)
})
# Show/hide processing indicator
observeEvent(input$run_benchmark, {
session$sendCustomMessage("showProcessing", TRUE)
# Hide after a delay to simulate processing
shiny::invalidateLater(1500, session)
observe({
session$sendCustomMessage("showProcessing", FALSE)
})
})
# JavaScript for UI updates
session$sendCustomMessage("setupProcessingHandler", "")
}
# Add JavaScript for processing indicator
tags$script(HTML("
Shiny.addCustomMessageHandler('showProcessing', function(show) {
var indicator = document.getElementById('processing');
var metrics = document.getElementById('metrics-display');
if (show) {
indicator.classList.add('active');
metrics.style.opacity = '0.5';
} else {
indicator.classList.remove('active');
metrics.style.opacity = '1';
}
});
Shiny.addCustomMessageHandler('setupProcessingHandler', function(data) {
// Handler is ready
});
"))
shinyApp(ui = ui, server = server)
Issue 2: Memory Issues with Reactive Updates
Problem: Frequent table updates cause memory accumulation and application slowdown.
Solution:
# Efficient reactive table updates
server <- function(input, output, session) {
# Use reactiveVal instead of reactive for better memory management
table_data <- reactiveVal()
# Debounce frequent updates
debounced_update <- reactive({
input$update_trigger
}) %>% debounce(1000) # Wait 1 second after last change
observeEvent(debounced_update(), {
# Update data only after debounce period
new_data <- fetch_updated_data()
table_data(new_data)
})
# Optimize table rendering
output$optimized_table <- DT::renderDataTable({
req(table_data())
# Use DT proxy for efficient updates
if(exists("table_proxy")) {
# Update existing table instead of recreating
DT::replaceData(table_proxy, table_data(), resetPaging = FALSE)
} else {
# Create new table
dt <- DT::datatable(
table_data(),
options = list(
pageLength = 15,
processing = TRUE
)
)
# Create proxy for future updates
table_proxy <<- DT::dataTableProxy("optimized_table")
return(dt)
}
})
# Memory cleanup
observe({
invalidateLater(60000) # Every minute
gc() # Force garbage collection
})
}Issue 3: Complex Filtering and Search Requirements
Problem: Users need advanced filtering capabilities beyond basic search functionality.
Solution:
# Advanced filtering implementation
create_advanced_filter_table <- function(data) {
server <- function(input, output, session) {
# Reactive filtered data
filtered_data <- reactive({
data_filtered <- data
# Apply text filters
if(!is.null(input$name_filter) && nchar(input$name_filter) > 0) {
data_filtered <- data_filtered[grepl(input$name_filter, data_filtered$Name, ignore.case = TRUE), ]
}
# Apply numeric range filters
if(!is.null(input$value_range)) {
data_filtered <- data_filtered[
data_filtered$Value >= input$value_range[1] &
data_filtered$Value <= input$value_range[2],
]
}
# Apply date range filters
if(!is.null(input$date_range)) {
data_filtered <- data_filtered[
data_filtered$Date >= input$date_range[1] &
data_filtered$Date <= input$date_range[2],
]
}
# Apply categorical filters
if(!is.null(input$category_filter) && length(input$category_filter) > 0) {
data_filtered <- data_filtered[data_filtered$Category %in% input$category_filter, ]
}
return(data_filtered)
})
# Advanced filter UI
output$advanced_filters <- renderUI({
tagList(
# Text search
textInput("name_filter", "Search Name:", placeholder = "Enter search term..."),
# Numeric range slider
sliderInput("value_range", "Value Range:",
min = min(data$Value, na.rm = TRUE),
max = max(data$Value, na.rm = TRUE),
value = c(min(data$Value, na.rm = TRUE), max(data$Value, na.rm = TRUE))),
# Date range picker
dateRangeInput("date_range", "Date Range:",
start = min(data$Date, na.rm = TRUE),
end = max(data$Date, na.rm = TRUE)),
# Multi-select for categories
checkboxGroupInput("category_filter", "Categories:",
choices = unique(data$Category),
selected = unique(data$Category)),
# Reset filters button
actionButton("reset_filters", "Reset All Filters", class = "btn-warning")
)
})
# Reset filters functionality
observeEvent(input$reset_filters, {
updateTextInput(session, "name_filter", value = "")
updateSliderInput(session, "value_range",
value = c(min(data$Value, na.rm = TRUE), max(data$Value, na.rm = TRUE)))
updateDateRangeInput(session, "date_range",
start = min(data$Date, na.rm = TRUE),
end = max(data$Date, na.rm = TRUE))
updateCheckboxGroupInput(session, "category_filter", selected = unique(data$Category))
})
# Filtered table
output$filtered_table <- DT::renderDataTable({
DT::datatable(
filtered_data(),
options = list(
pageLength = 15,
searching = FALSE, # Disable built-in search since we have custom filters
dom = 'Blfrtip',
buttons = c('copy', 'csv', 'excel')
),
extensions = 'Buttons'
)
})
# Filter summary
output$filter_summary <- renderText({
total_rows <- nrow(data)
filtered_rows <- nrow(filtered_data())
paste("Showing", filtered_rows, "of", total_rows, "records",
if(filtered_rows < total_rows) paste0("(", round(filtered_rows/total_rows * 100, 1), "% of total)") else "")
})
}
}
Data Table Performance Best Practices
Always consider your data size when choosing between client-side and server-side processing. Use server-side processing for datasets larger than 10,000 rows, implement debouncing for frequently updated tables, and consider virtual scrolling for read-only large datasets. Monitor memory usage and implement cleanup routines for long-running applications.
Test Your Understanding
Quiz Question 1: Performance Optimization Strategy
Your Shiny application displays a data table with 50,000 rows that users need to search, sort, and filter frequently. The current implementation is slow and causes browser freezing. What’s the most effective approach to optimize performance?
- Increase browser memory allocation and disable table features
- Implement server-side processing with pagination and search
- Split the data into multiple smaller tables across different tabs
- Use client-side processing with virtual scrolling only
- Consider the trade-offs between functionality and performance
- Think about which processing approach handles large datasets most efficiently
- Remember that user experience should remain smooth and responsive
B) Implement server-side processing with pagination and search
Server-side processing is optimal for large datasets:
# Optimal solution for large datasets
output$large_table <- DT::renderDataTable({
DT::datatable(
large_dataset,
options = list(
# Enable server-side processing
serverSide = TRUE,
processing = TRUE,
# Efficient pagination
pageLength = 25,
lengthMenu = c(10, 25, 50, 100),
# Maintain full functionality
searching = TRUE,
ordering = TRUE,
# Performance optimizations
deferRender = TRUE,
scrollX = TRUE
),
filter = 'top',
selection = 'multiple'
)
})Why server-side processing is optimal:
- Only processes and sends visible data to client
- Maintains full search and sort functionality
- Keeps browser responsive regardless of dataset size
- Scales efficiently to millions of rows
- Users get fast, smooth interaction experience
Quiz Question 2: Interactive Editing Implementation
You need to create a data table where users can edit values directly in cells, with validation to ensure data integrity. The table should support different input types (text, numbers, dropdowns) and provide immediate feedback for invalid entries. What’s the best implementation approach?
- Use DT’s built-in editing with custom validation callbacks
- Create separate modal dialogs for editing each row
- Replace the table with individual input controls for each cell
- Implement read-only table with separate editing forms
- Consider user experience and workflow efficiency
- Think about validation timing and feedback mechanisms
- Remember that different data types need different input methods
A) Use DT’s built-in editing with custom validation callbacks
DT’s native editing capabilities provide the best user experience:
# Optimal editable table implementation
output$editable_table <- DT::renderDataTable({
DT::datatable(
data,
options = list(
pageLength = 15,
# Column-specific editing configuration
columnDefs = list(
list(targets = 0, editable = FALSE), # ID not editable
list(targets = 2,
editor = list(
type = "select",
options = list(
list(label = "Option A", value = "A"),
list(label = "Option B", value = "B")
)
)
)
)
),
# Enable cell editing
editable = list(
target = 'cell',
disable = list(columns = c(0)) # Disable ID column
),
extensions = c('KeyTable', 'AutoFill')
)
})
# Handle edits with validation
observeEvent(input$editable_table_cell_edit, {
info <- input$editable_table_cell_edit
# Validate based on column type
if(validate_cell_edit(info$row, info$col, info$value)) {
# Update data
update_data(info$row, info$col, info$value)
showNotification("Cell updated successfully", type = "message")
} else {
showNotification("Invalid value entered", type = "error")
}
})Why DT editing is optimal:
- Seamless inline editing without workflow interruption
- Support for different input types per column
- Real-time validation and feedback
- Maintains table context and surrounding data visibility
- Professional user experience matching commercial applications
Quiz Question 3: Advanced Filtering Strategy
Your application needs sophisticated filtering capabilities where users can apply multiple criteria simultaneously (text search, numeric ranges, date ranges, and category selections). The filters should update the table in real-time and provide visual feedback about applied filters. What’s the most effective architecture?
- Use DT’s built-in column filters exclusively
- Create separate filter controls with reactive data processing
- Implement client-side JavaScript filtering functions
- Combine custom filter UI with DT’s search capabilities
- Consider the complexity of multiple simultaneous filters
- Think about performance with real-time updates
- Remember that users need clear feedback about active filters
B) Create separate filter controls with reactive data processing
Custom filter controls provide the most flexible and user-friendly solution:
# Optimal multi-criteria filtering system
server <- function(input, output, session) {
# Reactive filtered data with multiple criteria
filtered_data <- reactive({
data_filtered <- original_data
# Apply text filters
if(!is.null(input$text_search) && nchar(input$text_search) > 0) {
data_filtered <- data_filtered[
grepl(input$text_search, data_filtered$Name, ignore.case = TRUE),
]
}
# Apply numeric range filters
if(!is.null(input$price_range)) {
data_filtered <- data_filtered[
data_filtered$Price >= input$price_range[1] &
data_filtered$Price <= input$price_range[2],
]
}
# Apply date range filters
if(!is.null(input$date_range)) {
data_filtered <- data_filtered[
data_filtered$Date >= input$date_range[1] &
data_filtered$Date <= input$date_range[2],
]
}
# Apply category filters
if(!is.null(input$categories) && length(input$categories) > 0) {
data_filtered <- data_filtered[
data_filtered$Category %in% input$categories,
]
}
return(data_filtered)
})
# Filter summary for user feedback
output$filter_summary <- renderUI({
total <- nrow(original_data)
filtered <- nrow(filtered_data())
if(filtered < total) {
div(class = "alert alert-info",
paste("Showing", filtered, "of", total, "records"),
actionButton("clear_filters", "Clear All", class = "btn-sm btn-warning pull-right")
)
}
})
# Optimized table rendering
output$filtered_table <- DT::renderDataTable({
DT::datatable(
filtered_data(),
options = list(
pageLength = 20,
searching = FALSE, # Custom search instead
dom = 'Blfrtip'
)
)
})
}Why custom filtering is optimal:
- Complete control over filter logic and combinations
- Real-time updates with optimal performance
- Clear visual feedback about active filters
- Ability to implement complex business rules
- Better user experience than generic column filters
Conclusion
Mastering interactive data tables with the DT package transforms your Shiny applications from basic data displays into sophisticated exploration and analysis tools that rival commercial business intelligence platforms. The comprehensive techniques covered in this guide - from basic table implementation to advanced editing, styling, and real-time integration - provide the foundation for creating professional data applications that users genuinely want to use for their daily work.
The key to effective data table implementation lies in choosing the right approach for your specific use case: client-side processing for smaller datasets requiring maximum interactivity, server-side processing for large datasets requiring scalability, and hybrid approaches that balance performance with functionality. Understanding these trade-offs enables you to build applications that provide excellent user experiences regardless of data complexity.
Your expertise in interactive data tables enables you to create applications that bridge the gap between raw data and actionable insights, providing users with intuitive tools for data exploration, analysis, and decision-making. These capabilities are essential for building applications that truly serve business needs and drive data-driven decision making.
Next Steps
Based on your data table mastery, here are recommended paths for expanding your interactive Shiny development capabilities:
Immediate Next Steps (Complete These First)
- Interactive Plots and Charts - Combine data tables with coordinated interactive visualizations
- Building Interactive Dashboards - Integrate data tables into comprehensive dashboard layouts
- Practice Exercise: Build a comprehensive data analysis application that combines file upload, interactive tables, and dynamic filtering with export capabilities
Building on Your Foundation (Choose Your Path)
For Advanced Data Processing Focus:
For Enterprise Applications:
For Production Deployment:
Long-term Goals (2-4 Weeks)
- Build an enterprise data management platform with advanced table editing, user permissions, and audit logging
- Create a real-time analytics dashboard that displays live data updates in interactive tables with automated alerting
- Develop a collaborative data exploration tool where multiple users can filter, analyze, and share table views simultaneously
- Contribute to the Shiny community by creating reusable data table components or publishing advanced styling templates
Explore More Articles
Note
Here are more articles from the same category to help you dive deeper into the topic.
No matching items
Reuse
Citation
BibTeX citation:
@online{kassambara2025,
author = {Kassambara, Alboukadel},
title = {Interactive {Data} {Tables} in {Shiny:} {Master} {DT}
{Package} for {Professional} {Displays}},
date = {2025-05-23},
url = {https://www.datanovia.com/learn/tools/shiny-apps/interactive-features/data-tables.html},
langid = {en}
}
For attribution, please cite this work as:
Kassambara, Alboukadel. 2025. “Interactive Data Tables in Shiny:
Master DT Package for Professional Displays.” May 23, 2025. https://www.datanovia.com/learn/tools/shiny-apps/interactive-features/data-tables.html.