冲积图（Alluvial Plot）中小计数类别展示方案咨询——以‘Worse’类别为例

Hey there! I’ve dealt with this exact headache when working with small strata in alluvial plots—trying to fit text in tiny spaces either makes it unreadable or breaks the whole layout. Let’s walk through a couple of smart fixes, including that arrow-with-text-box approach you’re curious about.

First, let’s fix a couple of small issues in your original code first: you had a typo (Impoved instead of Improved) and n_id wasn’t defined. Let’s start with a cleaned-up base version, then add our tweaks.

Fix 1: Arrow + Text Box for Small Strata #

This is perfect for single tiny categories—we’ll manually place a text box outside the plot area and draw an arrow pointing to the small stratum. Here’s how to implement it:

library(alluvial)
library(ggalluvial)
library(ggplot2)

# Fix typo and define total count for y-axis
Shortterm <- c("Healed","Improved","Same","Worse","Healed","Improved","Same","Worse","Healed","Improved","Same","Worse")
Longterm <- c("Healed","Healed","Healed","Healed","Improved","Improved","Improved","Improved","Worse","Worse","Worse","Worse")
Frequence <- c(28,2,0,1,14,6,3,0,1,1,0,0)
Order <- c(0,0,0,0,1,1,1,1,2,2,2,2)
Improved <- c("Yes","Yes","Yes","Yes","Yes","Yes","Yes","Yes","No","No","No","No")

output <- data.frame(Shortterm,Longterm,Frequence,Order,Improved)
output$Improved <- factor(output$Improved, levels = c("Yes", "No"))
n_id <- sum(output$Frequence)

# Calculate vertical position of the "Worse" stratum in Short-term
worse_y_pos <- sum(output$Frequence[output$Shortterm != "Worse" & output$Order == 0]) + 
  (output$Frequence[output$Shortterm == "Worse" & output$Order == 0]/2)

ggplot(data = output, aes(axis1 = Shortterm, axis2 = Longterm, y = Frequence)) + 
  scale_x_discrete(limits = c("Short-term \n ~ 6 months", "Long-term \n ~ 15 years"),
                   expand = c(.2, .05), position="bottom") + 
  scale_y_continuous(label = scales::percent_format(scale = 100 /n_id),
                     breaks=c(0,1/4*n_id,1/2*n_id,3/4*n_id,n_id)) + 
  geom_alluvium(aes(fill = Improved)) + 
  geom_stratum() + 
  # Hide default text for the tiny stratum to avoid clutter
  geom_text(stat = "stratum", aes(label = after_stat(ifelse(stratum == "Worse" & after_stat(axis) == 1, "", stratum)))) + 
  scale_fill_manual(values = c("green", "red"))+ 
  theme_minimal() +
  # Add arrow pointing to the small stratum
  annotate("segment", 
           x = 0.7, xend = 1, # X positions: left of first axis to the axis itself
           y = worse_y_pos, yend = worse_y_pos,
           color = "black", arrow = arrow(length = unit(0.15, "cm"))) +
  # Add bordered text box with category and count
  annotate("text", 
           x = 0.5, y = worse_y_pos,
           label = "Worse (1)", 
           hjust = 1, vjust = 0.5,
           bg = "white", box.col = "black", box.padding = unit(0.3, "lines"))

How this works: #

• We calculate the exact vertical position of the tiny "Worse" stratum so the arrow lines up perfectly.
• We hide the default text for that stratum to avoid overlapping.
• annotate("segment") draws the arrow from the text box to the stratum.
• annotate("text") creates a bordered text box outside the plot area, keeping the label readable without crowding the stratum.

Fix 2: Merge Tiny Categories into "Other" #

If you have multiple small strata, merging them into an "Other" category makes the plot cleaner and ensures text fits properly. Here’s a quick way to do that:

library(dplyr)

# Merge Shortterm categories with frequency < 2 into "Other"
output$Shortterm <- case_when(
  output$Frequence < 2 & output$Shortterm == "Worse" ~ "Other",
  TRUE ~ output$Shortterm
)

# Re-sum frequencies for merged categories
output_merged <- output %>%
  group_by(Shortterm, Longterm, Improved, Order) %>%
  summarise(Frequence = sum(Frequence), .groups = "drop")

# Plot with merged category (use your original plot code with output_merged)
ggplot(data = output_merged, aes(axis1 = Shortterm, axis2 = Longterm, y = Frequence)) + 
  scale_x_discrete(limits = c("Short-term \n ~ 6 months", "Long-term \n ~ 15 years"),
                   expand = c(.2, .05), position="bottom") + 
  scale_y_continuous(label = scales::percent_format(scale = 100 /n_id),
                     breaks=c(0,1/4*n_id,1/2*n_id,3/4*n_id,n_id)) + 
  geom_alluvium(aes(fill = Improved)) + 
  geom_stratum() + 
  geom_text(stat = "stratum", aes(label = after_stat(stratum))) + 
  scale_fill_manual(values = c("green", "red"))+ 
  theme_minimal()

Fix 3: Interactive Plot with Hover Tooltips #

For a more modern solution, convert your static plot to an interactive one using plotly. Users can hover over tiny strata to see the category and count, no need to squeeze text into small spaces:

library(plotly)

# Create your base ggplot first
p <- ggplot(data = output, aes(axis1 = Shortterm, axis2 = Longterm, y = Frequence)) + 
  scale_x_discrete(limits = c("Short-term \n ~ 6 months", "Long-term \n ~ 15 years"),
                   expand = c(.2, .05), position="bottom") + 
  scale_y_continuous(label = scales::percent_format(scale = 100 /n_id),
                     breaks=c(0,1/4*n_id,1/2*n_id,3/4*n_id,n_id)) + 
  geom_alluvium(aes(fill = Improved)) + 
  geom_stratum() + 
  geom_text(stat = "stratum", aes(label = after_stat(stratum))) + 
  scale_fill_manual(values = c("green", "red"))+ 
  theme_minimal()

# Convert to interactive plot with hover details
ggplotly(p) %>%
  layout(hovermode = "x unified",
         annotations = list(text = "Hover over strata for details", x = 0, y = -0.1, showarrow = FALSE))

Each of these fixes addresses the readability issue without sacrificing clarity—pick the one that fits your audience and use case best!

内容的提问来源于stack exchange，提问作者martijn van Hooff