---
title: "Examples Gallery"
code-fold: true
---
A comprehensive showcase of webforest features. Each example focuses on demonstrating specific capabilities.
```{r}
#| include: false
library(webforest)
library(dplyr)
```
# Single-Feature Showcases
Each example highlights one key feature with maximum clarity.
## 1. Nested Hierarchical Groups
Three levels of nesting: Region → Country → Site. Click headers to collapse entire branches.
```{r}
nested_data <- tibble(
site = c(
"Boston General", "Mass Eye & Ear", "Johns Hopkins", "Cleveland Clinic",
"UCL Hospital", "Imperial College", "Charite Berlin", "LMU Munich",
"Tokyo University", "Osaka Medical", "Peking Union", "Shanghai Ruijin"
),
region = c(
rep("americas", 4),
rep("europe", 4),
rep("asia_pacific", 4)
),
country = c(
"usa", "usa", "usa", "usa",
"uk", "uk", "germany", "germany",
"japan", "japan", "china", "china"
),
hr = c(0.72, 0.68, 0.75, 0.71, 0.78, 0.82, 0.69, 0.74, 0.65, 0.70, 0.67, 0.72),
lower = c(0.58, 0.52, 0.61, 0.56, 0.64, 0.68, 0.54, 0.59, 0.50, 0.55, 0.52, 0.57),
upper = c(0.89, 0.89, 0.92, 0.90, 0.95, 0.99, 0.88, 0.93, 0.85, 0.89, 0.86, 0.91),
n = c(245, 189, 312, 278, 156, 134, 298, 267, 445, 389, 512, 478)
)
forest_plot(
nested_data,
point = "hr", lower = "lower", upper = "upper",
label = "site",
group = c("region", "country"), # Hierarchical: region > country
columns = list(
col_n("n"),
col_interval("HR (95% CI)")
),
theme = web_theme_modern(),
scale = "log", null_value = 1,
axis_label = "Hazard Ratio",
title = "Nested Hierarchical Groups",
subtitle = "Region → Country → Site (3 levels)",
caption = "Click any group header to collapse that branch and all children"
)
```
## 2. Multiple Effects Per Row
Five different analysis methods shown simultaneously. Vertical stacking reveals sensitivity.
```{r}
multi_effect_data <- tibble(
study = c("PIONEER", "SUMMIT", "HORIZON", "APEX", "ZENITH"),
n = c(2450, 1890, 3200, 1680, 2100),
# Primary (ITT)
itt_or = c(0.72, 0.78, 0.65, 0.81, 0.69),
itt_lo = c(0.58, 0.64, 0.52, 0.66, 0.55),
itt_hi = c(0.89, 0.95, 0.81, 0.99, 0.87),
# Multiple Imputation
mi_or = c(0.74, 0.80, 0.67, 0.83, 0.71),
mi_lo = c(0.60, 0.66, 0.54, 0.68, 0.57),
mi_hi = c(0.91, 0.97, 0.83, 1.01, 0.88),
# Complete Case
cc_or = c(0.70, 0.75, 0.63, 0.79, 0.67),
cc_lo = c(0.55, 0.60, 0.49, 0.63, 0.52),
cc_hi = c(0.89, 0.94, 0.81, 0.99, 0.86),
# Per-Protocol
pp_or = c(0.68, 0.73, 0.61, 0.77, 0.65),
pp_lo = c(0.53, 0.58, 0.47, 0.61, 0.50),
pp_hi = c(0.87, 0.92, 0.79, 0.97, 0.84),
# Tipping Point
tip_or = c(0.78, 0.84, 0.71, 0.87, 0.75),
tip_lo = c(0.63, 0.69, 0.57, 0.71, 0.60),
tip_hi = c(0.97, 1.02, 0.88, 1.07, 0.94)
)
forest_plot(
multi_effect_data,
point = "itt_or", lower = "itt_lo", upper = "itt_hi",
label = "study",
columns = list(
col_n("n"),
col_interval("Primary OR")
),
effects = list(
web_effect("itt_or", "itt_lo", "itt_hi", label = "ITT (Primary)", color = "#2563eb"),
web_effect("mi_or", "mi_lo", "mi_hi", label = "Multiple Imputation", color = "#7c3aed"),
web_effect("cc_or", "cc_lo", "cc_hi", label = "Complete Case", color = "#059669"),
web_effect("pp_or", "pp_lo", "pp_hi", label = "Per-Protocol", color = "#d97706"),
web_effect("tip_or", "tip_lo", "tip_hi", label = "Tipping Point", color = "#dc2626")
),
theme = web_theme_modern() |> set_spacing(row_height = 40),
scale = "log", null_value = 1,
axis_label = "Odds Ratio (95% CI)",
title = "Multiple Effects Per Row",
subtitle = "5 sensitivity analyses displayed simultaneously",
footnote = "Blue=ITT, Purple=MI, Green=CC, Orange=PP, Red=Tipping"
)
```
## 3. Table-Only Mode
No forest plot. Pure interactive table with rich column types.
```{r}
table_data <- tibble(
metric = c("Revenue", "Gross Profit", "EBITDA", "Net Income", "Free Cash Flow",
"Customer Count", "Churn Rate", "NPS Score", "CAC", "LTV"),
category = c(rep("Financial", 5), rep("Operational", 5)),
q1 = c(142, 98, 45, 28, 22, 12500, 2.8, 72, 185, 920),
q2 = c(156, 108, 52, 32, 28, 13200, 2.5, 74, 178, 945),
q3 = c(168, 118, 58, 38, 35, 14100, 2.3, 76, 172, 980),
q4 = c(185, 132, 68, 45, 42, 15200, 2.1, 78, 165, 1020),
yoy_pct = c(18.5, 22.1, 28.4, 35.2, 42.8, 21.6, -25.0, 8.3, -10.8, 10.9),
trend = list(
c(128, 135, 142, 156, 168, 185), c(85, 90, 98, 108, 118, 132),
c(38, 42, 45, 52, 58, 68), c(22, 25, 28, 32, 38, 45),
c(18, 20, 22, 28, 35, 42), c(10200, 11000, 12500, 13200, 14100, 15200),
c(3.5, 3.2, 2.8, 2.5, 2.3, 2.1), c(68, 70, 72, 74, 76, 78),
c(210, 198, 185, 178, 172, 165), c(850, 880, 920, 945, 980, 1020)
),
# Dummy effect data (required but not displayed)
effect = rep(1, 10), lower = rep(0.9, 10), upper = rep(1.1, 10)
)
webtable(
table_data,
point = "effect", lower = "lower", upper = "upper",
label = "metric", group = "category",
columns = list(
col_numeric("q4", "Q4 Actual", position = "left"),
col_bar("yoy_pct", "YoY %", position = "right"),
col_sparkline("trend", "6Q Trend", position = "right")
),
theme = web_theme_modern(),
title = "Table-Only Mode",
subtitle = "No forest plot - pure data table with bars and sparklines",
caption = "Using webtable() instead of forest_plot()"
)
```
## 4. Custom Theme Building
Building a branded theme from scratch with the fluent API.
```{r}
# Build a "Terminal" theme step by step
terminal_theme <- web_theme_default() |>
set_colors(
background = "#0c0c0c",
foreground = "#00ff00",
primary = "#00ff00",
secondary = "#008800",
muted = "#005500",
border = "#003300",
interval_positive = "#00ff00",
interval_negative = "#ff0000",
interval_line = "#00cc00",
summary_fill = "#00ff00",
summary_border = "#00aa00"
) |>
set_typography(
font_family = "'Courier New', monospace",
font_size_base = "0.85rem"
) |>
set_spacing(row_height = 28, header_height = 32) |>
set_shapes(point_size = 6, line_width = 1.5, border_radius = 0) |>
set_axis(gridlines = TRUE, gridline_style = "dotted")
theme_demo_data <- tibble(
process = c("AUTH_SERVICE", "API_GATEWAY", "DB_PRIMARY", "CACHE_LAYER", "MSG_QUEUE"),
latency_ms = c(12, 45, 8, 3, 28),
latency_se = c(2, 8, 1.5, 0.5, 5),
uptime = c(99.99, 99.95, 99.999, 99.99, 99.97),
rps = c(12500, 8900, 45000, 125000, 3200)
) |>
mutate(lower = latency_ms - 1.96 * latency_se, upper = latency_ms + 1.96 * latency_se)
forest_plot(
theme_demo_data,
point = "latency_ms", lower = "lower", upper = "upper",
label = "process",
columns = list(
col_numeric("uptime", "Uptime %", position = "left"),
col_numeric("rps", "RPS", position = "left"),
col_interval("Latency ms (95% CI)")
),
theme = terminal_theme,
null_value = 20,
axis_label = "Response Latency (ms)",
title = "Custom Theme: Terminal",
subtitle = "Built with set_colors(), set_typography(), set_spacing(), set_shapes()",
caption = "Monospace font, green-on-black, zero border radius"
)
```
## 5. Sparklines & Bars
Column visualizations for trends and magnitudes.
```{r}
viz_data <- tibble(
fund = c("Growth Fund A", "Value Fund B", "Index Fund C", "Bond Fund D", "REIT Fund E"),
return_1y = c(24.5, 12.8, 18.2, 4.5, 8.9),
return_se = c(4.2, 2.8, 3.1, 1.2, 2.5),
aum_b = c(45.2, 28.5, 125.8, 52.1, 18.9),
expense = c(0.85, 0.45, 0.03, 0.15, 0.65),
monthly_returns = list(
c(-2, 4, 3, -1, 5, 2, 4, -3, 6, 3, 2, 5),
c(1, 2, 1, 0, 2, 1, 1, 2, 1, 0, 1, 2),
c(1, 3, 2, 0, 3, 1, 2, -1, 4, 2, 1, 3),
c(0.5, 0.3, 0.4, 0.3, 0.4, 0.3, 0.4, 0.3, 0.4, 0.3, 0.4, 0.3),
c(1, -1, 2, 0, 1, 2, -1, 3, 0, 1, 1, 2)
),
flow_trend = list(
c(2.1, 2.5, 3.2, 4.1, 4.8, 5.2),
c(1.8, 1.6, 1.4, 1.2, 1.1, 0.9),
c(8.5, 9.2, 10.1, 11.5, 12.8, 14.2),
c(3.2, 3.4, 3.5, 3.6, 3.7, 3.8),
c(1.2, 1.4, 1.5, 1.3, 1.6, 1.8)
)
) |>
mutate(lower = return_1y - 1.96 * return_se, upper = return_1y + 1.96 * return_se)
forest_plot(
viz_data,
point = "return_1y", lower = "lower", upper = "upper",
label = "fund",
columns = list(
col_group("Fund Info",
col_bar("aum_b", "AUM ($B)"),
col_numeric("expense", "Expense %"),
position = "left"
),
col_group("Trends",
col_sparkline("monthly_returns", "12M Returns"),
col_sparkline("flow_trend", "6M Flows"),
position = "right"
),
col_interval("1Y Return % (95% CI)")
),
theme = web_theme_modern(),
null_value = 0,
axis_label = "1-Year Return (%)",
title = "Sparklines & Bars",
subtitle = "col_group() organizes related columns under shared headers",
caption = "Fund Info group on left, Trends group on right"
)
```
## 6. Row Styling
Headers, summaries, badges, indentation, and custom colors.
```{r}
styled_data <- tibble(
label = c(
"Primary Endpoint",
" Composite MACE", " CV Death", " MI", " Stroke",
"",
"Secondary Endpoints",
" All-cause mortality", " HF hospitalization",
"",
"Overall Summary"
),
hr = c(NA, 0.82, 0.88, 0.79, 0.76, NA, NA, 0.91, 0.72, NA, 0.80),
lower = c(NA, 0.74, 0.76, 0.68, 0.62, NA, NA, 0.79, 0.61, NA, 0.73),
upper = c(NA, 0.91, 1.02, 0.92, 0.93, NA, NA, 1.05, 0.85, NA, 0.88),
events = c(NA, 856, 312, 298, 246, NA, NA, 445, 412, NA, 1268),
rtype = c("header", rep("data", 4), "spacer", "header", "data", "data", "spacer", "summary"),
rbold = c(TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE),
rindent = c(0, 1, 2, 2, 2, 0, 0, 1, 1, 0, 0),
rcolor = c("#2563eb", NA, NA, NA, NA, NA, "#2563eb", NA, NA, NA, "#16a34a"),
rbadge = c(NA, "Primary", NA, NA, NA, NA, NA, NA, "Key", NA, "Pooled")
)
forest_plot(
styled_data,
point = "hr", lower = "lower", upper = "upper",
label = "label",
columns = list(
col_numeric("events", "Events"),
col_interval("HR (95% CI)")
),
row_type = "rtype", row_bold = "rbold", row_indent = "rindent",
row_color = "rcolor", row_badge = "rbadge",
theme = web_theme_modern(),
scale = "log", null_value = 1,
axis_label = "Hazard Ratio",
title = "Row Styling Features",
subtitle = "row_type, row_bold, row_indent, row_color, row_badge",
caption = "Headers in blue, summary in green, with badges and indentation"
)
```
## 7. Marker Styling
Customize marker shapes, colors, and opacity per row.
```{r}
marker_data <- tibble(
study = c("RCT-001", "RCT-002", "RCT-003", "OBS-001", "OBS-002", "OBS-003"),
design = c("RCT", "RCT", "RCT", "Observational", "Observational", "Observational"),
hr = c(0.72, 0.68, 0.75, 0.82, 0.78, 0.85),
lower = c(0.58, 0.52, 0.61, 0.68, 0.64, 0.71),
upper = c(0.89, 0.89, 0.92, 0.99, 0.95, 1.02),
pvalue = c(0.002, 0.001, 0.008, 0.045, 0.022, 0.068),
n = c(1250, 980, 1420, 2100, 1890, 1650),
# Marker styling columns
marker_shape = ifelse(design == "RCT", "circle", "square"),
marker_color = ifelse(pvalue < 0.05, "#16a34a", "#94a3b8"),
marker_opacity = ifelse(pvalue < 0.01, 1, 0.7)
)
forest_plot(
marker_data,
point = "hr", lower = "lower", upper = "upper",
label = "study",
group = "design",
columns = list(
col_n("n"),
col_pvalue("pvalue", "P"),
col_interval("HR (95% CI)")
),
marker_shape = "marker_shape",
marker_color = "marker_color",
marker_opacity = "marker_opacity",
theme = web_theme_modern(),
scale = "log", null_value = 1,
axis_label = "Hazard Ratio",
title = "Marker Styling",
subtitle = "Shape by study design, color by significance, opacity by p-value",
caption = "Circles = RCTs, Squares = Observational. Green = p<0.05, Gray = non-significant."
)
```
## 8. Annotations & Reference Lines
Custom reference lines with labels at specific values.
```{r}
annotation_data <- tibble(
study = c("LOW-DOSE", "MID-DOSE", "HIGH-DOSE", "COMBO-A", "COMBO-B"),
or = c(0.92, 0.75, 0.58, 0.62, 0.48),
lower = c(0.78, 0.62, 0.45, 0.50, 0.38),
upper = c(1.08, 0.91, 0.75, 0.77, 0.61),
dose_mg = c(50, 100, 200, 150, 250)
)
forest_plot(
annotation_data,
point = "or", lower = "lower", upper = "upper",
label = "study",
columns = list(
col_numeric("dose_mg", "Dose (mg)"),
col_interval("OR (95% CI)")
),
annotations = list(
forest_refline(0.80, label = "Clinically meaningful", style = "dashed", color = "#16a34a"),
forest_refline(0.50, label = "Target effect", style = "solid", color = "#dc2626")
),
theme = web_theme_modern(),
scale = "log", null_value = 1,
axis_label = "Odds Ratio",
title = "Annotations & Reference Lines",
subtitle = "forest_refline() adds labeled vertical lines",
caption = "Green dashed = clinically meaningful threshold, Red solid = target"
)
```
## 9. Axis Control
Custom range, explicit ticks, and gridlines.
```{r}
axis_data <- tibble(
study = c("Study A", "Study B", "Study C", "Study D", "Study E"),
or = c(0.45, 0.72, 1.00, 1.35, 2.10),
lower = c(0.28, 0.55, 0.78, 1.05, 1.52),
upper = c(0.72, 0.94, 1.28, 1.74, 2.90)
)
forest_plot(
axis_data,
point = "or", lower = "lower", upper = "upper",
label = "study",
columns = list(col_interval("OR (95% CI)")),
theme = web_theme_modern() |> set_axis(gridlines = TRUE, gridline_style = "dashed"),
scale = "log", null_value = 1,
axis_range = c(0.25, 4.0),
axis_ticks = c(0.25, 0.5, 1, 2, 4),
axis_label = "Odds Ratio (log scale)",
title = "Axis Control",
subtitle = "axis_range, axis_ticks, and gridlines",
caption = "Custom range [0.25, 4.0] with explicit tick positions on log scale"
)
```
---
# Combo Showcases
Multiple features working together.
## 10. Clinical Trial Program
Nested groups + multiple effects + sparklines + badges.
```{r}
set.seed(2024)
trial_program <- tibble(
site = c(
"MGH Boston", "UCSF", "Mayo Clinic",
"Oxford", "Charite", "Karolinska",
"Tokyo Univ", "Singapore GH", "Melbourne"
),
region = c(rep("americas", 3), rep("europe", 3), rep("asia_pacific", 3)),
country = c("usa", "usa", "usa", "uk", "germany", "sweden", "japan", "singapore", "australia"),
itt_hr = c(0.68, 0.72, 0.75, 0.78, 0.71, 0.82, 0.65, 0.69, 0.74),
itt_lo = c(0.52, 0.56, 0.60, 0.62, 0.55, 0.66, 0.49, 0.53, 0.58),
itt_hi = c(0.89, 0.93, 0.94, 0.98, 0.92, 1.02, 0.86, 0.90, 0.95),
pp_hr = c(0.64, 0.68, 0.71, 0.74, 0.67, 0.78, 0.61, 0.65, 0.70),
pp_lo = c(0.48, 0.52, 0.55, 0.58, 0.51, 0.62, 0.45, 0.49, 0.54),
pp_hi = c(0.85, 0.89, 0.92, 0.94, 0.88, 0.98, 0.83, 0.86, 0.91),
n = c(1250, 980, 1420, 890, 1100, 760, 1850, 1340, 1180),
trend = list(
c(0.85, 0.78, 0.72, 0.68, 0.67), c(0.88, 0.82, 0.76, 0.72, 0.71),
c(0.90, 0.85, 0.80, 0.76, 0.75), c(0.92, 0.88, 0.84, 0.79, 0.78),
c(0.86, 0.80, 0.75, 0.71, 0.70), c(0.94, 0.90, 0.86, 0.83, 0.82),
c(0.82, 0.75, 0.70, 0.66, 0.65), c(0.85, 0.78, 0.73, 0.69, 0.68),
c(0.88, 0.82, 0.78, 0.74, 0.73)
),
badge = c("Lead Site", NA, NA, NA, NA, NA, "Top Recruiter", NA, NA)
)
forest_plot(
trial_program,
point = "itt_hr", lower = "itt_lo", upper = "itt_hi",
label = "site", group = c("region", "country"),
columns = list(
col_n("n"),
col_sparkline("trend", "HR Trend"),
col_interval("ITT HR (95% CI)")
),
effects = list(
web_effect("itt_hr", "itt_lo", "itt_hi", label = "ITT", color = "#2563eb"),
web_effect("pp_hr", "pp_lo", "pp_hi", label = "Per-Protocol", color = "#16a34a")
),
row_badge = "badge",
theme = web_theme_dark(),
scale = "log", null_value = 1,
axis_label = "Hazard Ratio",
title = "Clinical Trial Program",
subtitle = "Nested groups + dual effects + sparklines + badges",
caption = "Combining hierarchical structure with sensitivity analysis"
)
```
## 11. Executive Dashboard
Table-only + bars + sparklines + row styling.
```{r}
exec_dashboard <- tibble(
department = c(
"COMPANY TOTAL", "",
"Engineering", " Platform", " Infrastructure", " Mobile",
"",
"Product", " Design", " Research",
"",
"Sales", " Enterprise", " SMB"
),
headcount = c(1250, NA, 480, 180, 150, 150, NA, 220, 85, 135, NA, 550, 320, 230),
revenue_m = c(185, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 185, 142, 43),
growth = c(24, NA, 32, 45, 28, 18, NA, 28, 35, 22, NA, 18, 22, 12),
satisfaction = c(78, NA, 82, 85, 80, 81, NA, 76, 79, 74, NA, 75, 77, 72),
trend = list(
c(1050, 1100, 1150, 1180, 1220, 1250), NULL,
c(380, 400, 420, 440, 460, 480), c(140, 150, 160, 170, 175, 180),
c(120, 130, 140, 145, 148, 150), c(120, 120, 125, 130, 140, 150), NULL,
c(180, 190, 200, 208, 215, 220), c(65, 70, 75, 80, 82, 85),
c(115, 120, 125, 128, 132, 135), NULL,
c(490, 505, 520, 532, 542, 550), c(280, 290, 300, 308, 315, 320),
c(210, 215, 220, 224, 227, 230)
),
effect = rep(1, 14), lower = rep(0.9, 14), upper = rep(1.1, 14),
rtype = c("summary", "spacer", "header", rep("data", 3), "spacer",
"header", "data", "data", "spacer", "header", "data", "data"),
rbold = c(TRUE, FALSE, TRUE, rep(FALSE, 3), FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE),
rindent = c(0, 0, 0, 1, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1),
rcolor = c("#16a34a", NA, "#2563eb", NA, NA, NA, NA, "#2563eb", NA, NA, NA, "#2563eb", NA, NA)
)
webtable(
exec_dashboard,
point = "effect", lower = "lower", upper = "upper",
label = "department",
columns = list(
col_numeric("headcount", "HC", position = "left"),
col_numeric("revenue_m", "Rev $M", position = "left"),
col_bar("growth", "Growth %", position = "right"),
col_numeric("satisfaction", "eNPS", position = "right"),
col_sparkline("trend", "6M Trend", position = "right")
),
row_type = "rtype", row_bold = "rbold", row_indent = "rindent", row_color = "rcolor",
theme = web_theme_modern(),
title = "Executive Dashboard",
subtitle = "Table-only with hierarchical org structure",
caption = "Combining webtable() with row styling for org charts"
)
```
## 12. Publication Meta-Analysis
Row styling + annotations + axis control using the `glp1_trials` package dataset.
```{r}
# Using the glp1_trials package dataset
data(glp1_trials)
forest_plot(
glp1_trials,
point = "hr", lower = "lower", upper = "upper",
label = "study",
group = "group",
columns = list(
col_group("Study Info",
col_text("drug", "Drug"),
col_n("n"),
position = "left"
),
col_group("Results",
col_events("events", "n", "Events"),
col_interval("HR (95% CI)"),
col_pvalue("pvalue", "P"),
position = "right"
)
),
annotations = list(
forest_refline(0.85, label = "Pooled HR", style = "dashed", color = "#00407a")
),
row_type = "row_type", row_bold = "row_bold",
theme = web_theme_lancet(),
scale = "log", null_value = 1,
axis_range = c(0.4, 1.5),
axis_ticks = c(0.5, 0.75, 1.0, 1.25),
axis_gridlines = TRUE,
axis_label = "Hazard Ratio (95% CI)",
title = "GLP-1 Agonist Cardiovascular Outcomes",
subtitle = "Row grouping by trial type + column grouping for Study Info / Results",
caption = "Major adverse cardiovascular events (MACE)",
footnote = "See ?glp1_trials for data documentation"
)
```
## 13. The Full Monty
Everything at once. Maximum feature density.
```{r}
full_monty <- tibble(
study = c(
"ALPHA-01", "ALPHA-02",
"BETA-01", "BETA-02", "BETA-03",
"GAMMA-01", "GAMMA-02"
),
program = c(rep("program_a", 2), rep("program_b", 3), rep("program_c", 2)),
phase = c("Phase_II", "Phase_II", "Phase_III", "Phase_III", "Phase_III", "Phase_II", "Phase_III"),
# Three effects
primary_hr = c(0.68, 0.72, 0.65, 0.71, 0.74, 0.78, 0.69),
primary_lo = c(0.52, 0.56, 0.50, 0.55, 0.58, 0.62, 0.53),
primary_hi = c(0.89, 0.93, 0.85, 0.92, 0.95, 0.98, 0.90),
secondary_hr = c(0.72, 0.76, 0.69, 0.75, 0.78, 0.82, 0.73),
secondary_lo = c(0.56, 0.60, 0.53, 0.59, 0.62, 0.66, 0.57),
secondary_hi = c(0.93, 0.96, 0.90, 0.95, 0.98, 1.02, 0.94),
safety_hr = c(0.85, 0.88, 0.82, 0.86, 0.89, 0.92, 0.84),
safety_lo = c(0.68, 0.72, 0.65, 0.69, 0.72, 0.75, 0.67),
safety_hi = c(1.06, 1.08, 1.04, 1.07, 1.10, 1.13, 1.05),
n = c(420, 380, 1250, 980, 1100, 560, 890),
weight = c(8, 7, 22, 18, 20, 10, 15),
pvalue = c(0.008, 0.015, 0.001, 0.004, 0.012, 0.042, 0.003),
trend = list(
c(0.85, 0.78, 0.72, 0.68), c(0.88, 0.82, 0.76, 0.72),
c(0.82, 0.75, 0.69, 0.65), c(0.86, 0.80, 0.75, 0.71),
c(0.88, 0.82, 0.78, 0.74), c(0.92, 0.88, 0.84, 0.78),
c(0.84, 0.78, 0.73, 0.69)
),
badge = c("Lead", NA, "Pivotal", NA, NA, NA, "Fast Track")
)
# Custom theme
monty_theme <- web_theme_dark() |>
set_colors(primary = "#f59e0b", interval_positive = "#22c55e", interval_negative = "#ef4444") |>
set_spacing(row_height = 38) |>
set_axis(gridlines = TRUE, gridline_style = "dotted")
forest_plot(
full_monty,
point = "primary_hr", lower = "primary_lo", upper = "primary_hi",
label = "study", group = c("program", "phase"),
columns = list(
col_n("n"),
col_bar("weight"),
col_group("Results",
col_interval("HR (95% CI)"),
col_pvalue("pvalue", "P"),
position = "right"
),
col_sparkline("trend", "Trend", position = "right")
),
effects = list(
web_effect("primary_hr", "primary_lo", "primary_hi", label = "Primary", color = "#22c55e"),
web_effect("secondary_hr", "secondary_lo", "secondary_hi", label = "Secondary", color = "#3b82f6"),
web_effect("safety_hr", "safety_lo", "safety_hi", label = "Safety", color = "#f59e0b")
),
annotations = list(
forest_refline(0.75, label = "Target", style = "dashed", color = "#a855f7")
),
row_badge = "badge",
theme = monty_theme,
scale = "log", null_value = 1,
axis_range = c(0.4, 1.2),
axis_label = "Hazard Ratio",
title = "The Full Monty",
subtitle = "Nested groups + 3 effects + sparklines + weights + annotations + custom theme",
caption = "Every major feature combined in one visualization",
footnote = "Green=Primary, Blue=Secondary, Orange=Safety. Purple line=Target."
)
```
---
# Publication Templates
Clean, professional examples for different contexts.
## 14. JAMA Style
Dense, minimal, black and white. Interaction p-values for subgroups.
```{r}
jama_data <- tibble(
subgroup = c(
"Overall",
"",
"Age",
" <65 years", " >=65 years",
"",
"Sex",
" Male", " Female",
"",
"Baseline risk",
" Low", " Intermediate", " High"
),
hr = c(0.76, NA, NA, 0.72, 0.82, NA, NA, 0.74, 0.79, NA, NA, 0.85, 0.75, 0.68),
lower = c(0.68, NA, NA, 0.62, 0.70, NA, NA, 0.64, 0.67, NA, NA, 0.72, 0.63, 0.54),
upper = c(0.85, NA, NA, 0.84, 0.96, NA, NA, 0.86, 0.93, NA, NA, 1.00, 0.89, 0.86),
n = c(8500, NA, NA, 4200, 4300, NA, NA, 5200, 3300, NA, NA, 2800, 3400, 2300),
p_int = c(NA, NA, NA, NA, 0.18, NA, NA, NA, 0.42, NA, NA, NA, NA, 0.03),
rtype = c("summary", "spacer", "header", "data", "data", "spacer", "header", "data", "data", "spacer", "header", "data", "data", "data"),
rbold = c(TRUE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE),
rindent = c(0, 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1, 1)
)
forest_plot(
jama_data,
point = "hr", lower = "lower", upper = "upper",
label = "subgroup",
columns = list(
col_numeric("n", "No."),
col_interval("HR (95% CI)"),
col_pvalue("p_int", "P Interaction")
),
row_type = "rtype", row_bold = "rbold", row_indent = "rindent",
theme = web_theme_jama(),
scale = "log", null_value = 1,
axis_label = "Hazard Ratio (95% CI)",
title = "Figure 2. Subgroup Analyses",
footnote = "HR indicates hazard ratio. P values are for interaction."
)
```
## 15. Lancet Style
Serif fonts, blue palette, with row grouping and column grouping.
```{r}
lancet_data <- tibble(
outcome = c(
"CV death or HF hospitalization",
"Cardiovascular death",
"HF hospitalization",
"All-cause mortality",
"Change in KCCQ score"
),
category = c("Primary", "Components", "Components", "Secondary", "Secondary"),
hr = c(0.74, 0.82, 0.70, 0.88, 0.85),
lower = c(0.66, 0.72, 0.61, 0.76, 0.74),
upper = c(0.83, 0.94, 0.81, 1.02, 0.98),
events_tx = c(447, 156, 291, 222, NA),
events_ctrl = c(606, 199, 407, 253, NA),
n_tx = c(2373, 2373, 2373, 2373, 2200),
n_ctrl = c(2371, 2371, 2371, 2371, 2180)
)
forest_plot(
lancet_data,
point = "hr", lower = "lower", upper = "upper",
label = "outcome",
group = "category",
columns = list(
col_group("Treatment",
col_n("events_tx", "Events"),
col_n("n_tx", "N"),
position = "left"
),
col_group("Control",
col_n("events_ctrl", "Events"),
col_n("n_ctrl", "N"),
position = "left"
),
col_interval("HR (95% CI)")
),
theme = web_theme_lancet(),
scale = "log", null_value = 1,
axis_label = "Hazard Ratio (95% CI)",
title = "Figure 3: Efficacy Outcomes",
subtitle = "Row groups by endpoint type + column groups by treatment arm",
caption = "HR<1 favours treatment.",
footnote = "Cox proportional hazards model stratified by region."
)
```
## 16. Minimal Print
Maximum density, pure black and white, with row and column grouping.
```{r}
minimal_data <- tibble(
trial = c("ADVANCE", "CARDINAL", "ELEVATE", "FRONTIER", "GENESIS", "HORIZON"),
phase = c("Phase III", "Phase III", "Phase III", "Phase II", "Phase II", "Phase III"),
n = c(1680, 1520, 1890, 2100, 980, 1450),
events = c(168, 152, 189, 210, 98, 145),
hr = c(0.74, 0.78, 0.71, 0.82, 0.69, 0.76),
lower = c(0.62, 0.66, 0.60, 0.71, 0.55, 0.64),
upper = c(0.88, 0.92, 0.84, 0.95, 0.87, 0.90),
weight = c(17.2, 16.8, 19.5, 21.2, 10.1, 15.2)
)
forest_plot(
minimal_data,
point = "hr", lower = "lower", upper = "upper",
label = "trial",
group = "phase",
columns = list(
col_group("Sample",
col_n("n"),
col_numeric("events", "Events"),
position = "left"
),
col_group("Results",
col_bar("weight"),
col_interval("HR (95% CI)"),
position = "right"
)
),
theme = web_theme_minimal(),
scale = "log", null_value = 1,
axis_label = "Hazard Ratio",
title = "Forest Plot",
subtitle = "Row groups by phase + column groups for Sample / Results",
footnote = "Random-effects model. Weights from inverse variance."
)
```
---
# Split Forest Plots
Navigate between subgroups using an interactive sidebar.
## 17. Regional Subgroup Analysis
Split by a single variable with floating sidebar navigation.
```{r}
set.seed(42)
n_studies <- 40
regional_data <- tibble(
study = paste0("Study ", sprintf("%02d", 1:n_studies)),
region = sample(c("North America", "Europe", "Asia Pacific"), n_studies,
replace = TRUE, prob = c(0.4, 0.35, 0.25)),
or = exp(rnorm(n_studies, log(0.78), 0.3)),
lower = or * exp(-1.96 * runif(n_studies, 0.15, 0.35)),
upper = or * exp(1.96 * runif(n_studies, 0.15, 0.35)),
n = sample(100:500, n_studies)
)
forest_plot(
regional_data,
point = "or", lower = "lower", upper = "upper",
label = "study",
split_by = "region",
columns = list(
col_n("n"),
col_interval("OR (95% CI)")
),
scale = "log", null_value = 1,
theme = web_theme_modern(),
axis_label = "Odds Ratio (95% CI)",
title = "Regional Subgroup Analysis",
subtitle = "Click sidebar to navigate between regions",
caption = "Floating sidebar with search and keyboard navigation"
)
```
## 18. Hierarchical Subgroups
Two-level split: Sex > Age Group. Expanding tree navigation.
```{r}
set.seed(123)
n <- 60
hierarchical_data <- tibble(
study = paste0("Study ", sprintf("%02d", 1:n)),
sex = sample(c("Male", "Female"), n, replace = TRUE),
age_group = sample(c("18-40", "41-65", "65+"), n, replace = TRUE),
treatment = sample(c("Drug A", "Drug B"), n, replace = TRUE),
or = exp(rnorm(n, log(0.75), 0.28)),
lower = or * exp(-1.96 * 0.22),
upper = or * exp(1.96 * 0.22)
)
hierarchical_data |>
web_spec(
point = "or", lower = "lower", upper = "upper",
label = "study",
scale = "log", null_value = 1,
columns = list(
col_text("treatment", "Treatment"),
col_interval("OR (95% CI)")
)
) |>
split_forest(by = c("sex", "age_group")) |>
forest_plot(
theme = web_theme_modern(),
axis_label = "Odds Ratio",
title = "Hierarchical Subgroup Analysis",
subtitle = "Sex > Age Group navigation tree",
caption = "Section headers show split variable names"
)
```
## 19. Three-Level Clinical Trial
Region > Country > Site with shared axis for consistent comparison.
```{r}
set.seed(456)
n <- 45
clinical_data <- tibble(
site = paste0("Site ", sprintf("%02d", 1:n)),
region = sample(c("Americas", "Europe", "Asia"), n, replace = TRUE, prob = c(0.35, 0.35, 0.3)),
country = case_when(
region == "Americas" ~ sample(c("USA", "Canada", "Brazil"), n, replace = TRUE),
region == "Europe" ~ sample(c("UK", "Germany", "France"), n, replace = TRUE),
region == "Asia" ~ sample(c("Japan", "China", "Korea"), n, replace = TRUE)
),
hr = exp(rnorm(n, log(0.72), 0.25)),
lower = hr * exp(-1.96 * 0.2),
upper = hr * exp(1.96 * 0.2),
n_patients = sample(50:300, n)
)
forest_plot(
clinical_data,
point = "hr", lower = "lower", upper = "upper",
label = "site",
split_by = c("region", "country"),
shared_axis = TRUE, # Consistent scale across all subgroups
columns = list(
col_n("n_patients", "N"),
col_interval("HR (95% CI)")
),
scale = "log", null_value = 1,
theme = web_theme_dark(),
axis_label = "Hazard Ratio",
title = "Global Clinical Trial Program",
subtitle = "Region > Country hierarchy with shared axis",
caption = "shared_axis = TRUE ensures consistent visual comparison"
)
```
---
# Fun Examples
Non-clinical examples showcasing webforest's versatility.
## 20. NBA Player Efficiency
Sports analytics using the `nba_efficiency` package dataset.
```{r}
#| fig-height: 8
data(nba_efficiency)
forest_plot(
nba_efficiency,
label = "player",
point = "per",
lower = "per_lower",
upper = "per_upper",
group = "conference",
columns = list(
col_group("Player Info",
col_text("team", "Team", width = 50),
col_text("position", "Pos", width = 40),
position = "left"
),
col_group("Stats",
col_numeric("ppg", "PPG"),
col_numeric("games", "GP", decimals = 0),
position = "left"
),
col_interval("PER (95% CI)")
),
row_badge = "award",
null_value = 15, # League average PER
theme = web_theme_modern() |>
set_colors(
primary = "#C9082A", # NBA red
interval_positive = "#17408B", # NBA blue
interval_negative = "#C9082A"
),
axis_label = "Player Efficiency Rating",
title = "NBA Player Efficiency Ratings",
subtitle = "Row groups by conference + column groups for Player Info / Stats",
caption = "PER = 15 is league average. Badge shows major awards.",
footnote = "Data simulated based on typical NBA statistics"
)
```
## 21. Rich Column Types
Showcasing badges, icons, stars, images, and ranges.
```{r}
rich_columns_data <- tibble(
study = c("ADVANCE", "CARDINAL", "ELEVATE", "FRONTIER", "GENESIS"),
status = c("Published", "Draft", "Published", "In Review", "Published"),
quality = c(4, 3, 5, 4, 3),
age_min = c(18, 21, 25, 18, 30),
age_max = c(65, 75, 70, 80, 65),
validated = c("yes", "no", "yes", "yes", "no"),
doi = c("10.1001/jama.2024.1234", "10.1016/j.lancet.2024.5678",
"10.1056/NEJMoa2024.9012", "10.1136/bmj.2024.3456",
"10.1161/CIRCULATIONAHA.2024.7890"),
hr = c(0.74, 0.78, 0.71, 0.82, 0.69),
lower = c(0.62, 0.66, 0.60, 0.71, 0.55),
upper = c(0.88, 0.92, 0.84, 0.95, 0.87)
)
forest_plot(
rich_columns_data,
point = "hr", lower = "lower", upper = "upper",
label = "study",
columns = list(
col_badge("status", "Status",
variants = list(Published = "success", Draft = "warning", `In Review` = "info"),
position = "left"
),
col_stars("quality", "Quality", position = "left"),
col_range("age_min", "age_max", header = "Age", position = "left"),
col_icon("validated", "Valid",
mapping = list(yes = "✓", no = "✗"),
color = "#16a34a", position = "left"
),
col_reference("doi", "DOI", max_chars = 20, position = "right"),
col_interval("HR (95% CI)")
),
theme = web_theme_modern(),
scale = "log", null_value = 1,
axis_label = "Hazard Ratio",
title = "Rich Column Types",
subtitle = "Badges, stars, ranges, icons, and references",
caption = "New column types for enhanced data presentation"
)
```
## 22. Airline Performance
Transportation analytics using the `airline_delays` package dataset, with row and column grouping.
```{r}
data(airline_delays)
# Aggregate to carrier level with carrier type
carrier_summary <- airline_delays |>
group_by(carrier, carrier_type) |>
summarise(
delay_vs_avg = mean(delay_vs_avg),
delay_lower = mean(delay_lower),
delay_upper = mean(delay_upper),
on_time_pct = mean(on_time_pct),
satisfaction = mean(satisfaction),
flights = sum(flights),
trend = list(unlist(trend[1])),
.groups = "drop"
) |>
arrange(carrier_type, delay_vs_avg)
forest_plot(
carrier_summary,
label = "carrier",
point = "delay_vs_avg",
lower = "delay_lower",
upper = "delay_upper",
group = "carrier_type",
columns = list(
col_group("Service",
col_percent("on_time_pct", "On-Time", decimals = 0),
col_numeric("satisfaction", "Rating", decimals = 1),
position = "left"
),
col_group("Trends",
col_sparkline("trend", "12M"),
col_interval("Delay (min)"),
position = "right"
)
),
null_value = 0,
theme = web_theme_modern() |>
set_colors(
interval_positive = "#16a34a", # Green = good (early)
interval_negative = "#dc2626" # Red = bad (late)
),
axis_label = "Delay vs. Industry Average (minutes)",
title = "Airline Carrier Performance",
subtitle = "Row groups by carrier type + column groups for Service / Trends",
caption = "Negative values = ahead of schedule",
footnote = "Satisfaction on 1-5 scale"
)
```