如何用ggplot修正/高亮时间序列图中非代表性峰值

Got it, let's work through this problem. You're dealing with a date (2020-09-10) that has way too few samples, making its mean score look like an unrepresentative peak—and you don't want to delete the real data. Below are two practical, ggplot2-based approaches to highlight this problematic point and make your trend clearer:

Approach 1: Highlight the Low-Sample Date + Add a "Normalized" Trend Line #

This method keeps your original mean/confidence interval data, but visually flags the low-sample date and adds a trend line that ignores the outlier to show the expected pattern.

First, we'll add a flag to our emmeans data to identify the low-sample date, then adjust the plot to style it differently and add a smoothed trend excluding that point:

# First, calculate sample sizes per date to identify the low-n date
sample_sizes <- actual_df %>% 
  count(date) %>% 
  mutate(is_low_n = n < 50) # Adjust threshold based on your typical sample sizes

# Merge sample size flag with emmeans data
emmeans_with_flags <- emmeans_fit_data %>% 
  as_tibble() %>% 
  left_join(sample_sizes, by = "date")

# Plot with highlights and normalized trend
emmeans_with_flags %>% 
  ggplot(aes(x = date, y = emmean)) +
  # Add a smoothed trend line that skips the low-sample date
  geom_smooth(data = . %>% filter(!is_low_n), 
              method = "lm", se = FALSE, color = "#999999", linetype = "dashed", lwd = 0.8) +
  # Original line (breaks at the low-sample date to show raw trend)
  geom_line(color = "#1a476f", group = 1, lwd = 1) +
  # Error bars - style low-sample one differently
  geom_errorbar(aes(ymin = lower.CL, ymax = upper.CL, color = is_low_n), 
                alpha = 0.5, width = 0.2) +
  # Points - make low-sample one stand out with a white fill
  geom_point(aes(fill = is_low_n), size = 4, shape = 21, color = "black") +
  # Text labels for all daily means
  geom_text(aes(label = paste0(round(100*emmean, 1), "%")), 
            vjust = -4, hjust = 0.5, size = 3.5) +
  # Add an annotation explaining the low-sample date
  annotate("text", x = as.Date("2020-09-10"), y = max(emmeans_with_flags$upper.CL) + 0.05,
           label = "Low sample size (n=15)", color = "#90353b", size = 3) +
  # Scale adjustments
  scale_y_continuous(labels = function(x) paste0(100*x, "%"), limits = c(0, 1)) +
  scale_color_manual(values = c("#1a476f", "#90353b")) +
  scale_fill_manual(values = c("#1a476f", "#ffffff")) +
  # Theme tweaks
  labs(title = "Mood Over Time", y = "Level of Happiness") +
  theme(plot.title = element_text(hjust = 0.5, size = 14),
        axis.text.x = element_text(angle = -60, hjust = 0),
        axis.title.x = element_blank(),
        legend.position = "none")

What this does:

• The dashed gray line shows the expected trend if we exclude the low-sample date, so viewers can easily compare the outlier to the typical pattern
• The low-sample date's error bar and point are styled with a red color and white fill to immediately draw attention
• We add a direct annotation explaining why this point is unusual
• All original data is retained—no deletion required

Approach 2: Use Smoothing Models to Reduce Outlier Impact #

If you want a single, cohesive trend line that naturally downweights the low-sample point (instead of splitting the line), you can use a local regression (loess) or generalized additive model (GAM) directly on your raw data, while still overlaying the daily means.

Here's how to do it with geom_smooth():

# First, convert date to numeric for smoother fitting (optional but helps with loess)
actual_df <- actual_df %>% 
  mutate(date_num = as.numeric(date))

# Plot raw-based smooth + daily means
actual_df %>% 
  ggplot(aes(x = date, y = score)) +
  # Add a loess smooth (automatically downweights low-n points since they contribute less to the local fit)
  geom_smooth(method = "loess", se = TRUE, color = "#1a476f", fill = "#1a476f", alpha = 0.2) +
  # Overlay the daily means from emmeans
  geom_point(data = emmeans_with_flags, aes(y = emmean), size = 3, color = "#90353b") +
  geom_errorbar(data = emmeans_with_flags, aes(y = emmean, ymin = lower.CL, ymax = upper.CL),
                color = "#90353b", width = 0.2, alpha = 0.5) +
  # Label the low-sample point with its sample size for clarity
  geom_text(data = emmeans_with_flags %>% filter(is_low_n), 
            aes(y = emmean, label = paste0(round(100*emmean, 1), "% (n=15)")),
            vjust = -2, hjust = 0.5, color = "#90353b", size = 3.5) +
  # Scale adjustments
  scale_y_continuous(labels = function(x) paste0(100*x, "%")) +
  # Theme tweaks
  labs(title = "Mood Over Time (Smoothed Trend)", y = "Level of Happiness") +
  theme(plot.title = element_text(hjust = 0.5, size = 14),
        axis.text.x = element_text(angle = -60, hjust = 0),
        axis.title.x = element_blank())

What this does:

• The loess smooth line uses all raw data but gives less weight to the date with only 15 samples, so the overall trend isn't distorted by the outlier
• We still show the actual daily means and confidence intervals, so viewers can see the raw summary stats alongside the smoothed trend
• We directly label the low-sample point with its sample size to contextualize the unusual value

Both approaches keep your real data intact while making the visualization far more interpretable. You can tweak colors, sample size thresholds, and smoothing methods to match your specific needs!

内容的提问来源于stack exchange，提问作者Emman