GEOM_RIBBON具有特定条件

Question

如何修改我的ggplot2代码，以便仅当Val≤ -1至少连续两个月时才会出现功能区填充，并且不会超过Val> -1？

虚拟数据：

library(tibble)
library(lubridate)

dates <- seq(from = as.Date("1997-01-01"), to = as.Date("1998-12-01"), by = "month")
dummy <- tibble(
  Date = rep(dates, each = 6),  # 2 AREA × 3 METRIC = 6 baris per bulan
  AREA = rep(c("NORTHERN", "SOUTHERN"), each = 3, times = length(dates)),
  Year = year(rep(dates, each = 6)),
  GROUP = paste(year(rep(dates, each = 6)), year(rep(dates, each = 6)) + 1, sep = "/"),
  METRIC = rep(c("SPI3", "SPI6", "SPI12"), times = length(dates) * 2),
  VAL = round(runif(length(dates) * 6, -3.5, 3.5), 2),  # SPI acak antara -3.5 hingga 3.5
  ID = ifelse(round(runif(length(dates) * 6, -3.5, 3.5), 2) <= -1, "DROUGHT", "NOT-DROUGHT"),
  fill_color = ifelse(round(runif(length(dates) * 6, -3.5, 3.5), 2) <= -1, "red", "gray")
)

图：

ggplot(data = spi_df, aes(x = Date, y = VAL, col = AREA, group = AREA)) +
  geom_line() +  
  geom_ribbon(data = spi_df%>%filter(VAL<=-1),
              aes(x=Date,ymin = VAL, ymax = -1, group = AREA), 
              fill = "red, colour= "transparent",linetype = 0,
              alpha = 0.3) + 
  facet_grid(~METRIC~GROUP, scales = "free_x") +
  coord_cartesian(expand = FALSE) +
  theme_bw() +
  labs(y = "SPI") +
  scale_y_continuous(breaks = seq(-4, 4, 1), limits = c(-4, 4)) +
  theme(legend.position = "bottom")  

Answer 1

用您的示例代码将两件事固定：

spi_df

到

dummy

，并修复无与伦比的报价...

在此之后，我建议第一步是添加仅在与您的状况匹配

< -1

时具有数据的列。这是第一步；虽然这是第一步，但它确实显示出一个弱点：您的数据不是真正连续的，因此当下一个点超过-1时，红丝带不会流向倾斜的线路。

dummy |>
  arrange(Date) |>
  mutate(VAL_neg = if_else(VAL <= -1, VAL, NA)) |>
  mutate(
    .by = c(METRIC, GROUP, AREA),
    VAL_neg_grp = consecutive_id(is.na(VAL_neg))
  ) |> 
  mutate(
    .by = c(METRIC, GROUP, AREA, VAL_neg_grp),
    VAL_neg = if (n() > 1) VAL_neg else NA
  ) |>
  ggplot(aes(x = Date, y = VAL, col = AREA, group = AREA)) +
  geom_line() +  
  geom_ribbon(aes(x=Date, ymin = VAL_neg, ymax = -1, group = paste(AREA, VAL_neg_grp)), 
              # notice the "~" for filtering of current data, not original `dummy`
              data = ~ filter(.x, !is.na(VAL_neg)),
              fill = "red", colour= "transparent",linetype = 0,
              alpha = 0.3, na.rm = TRUE) + 
  facet_grid(~METRIC~GROUP, scales = "free_x") +
  coord_cartesian(expand = FALSE) +
  theme_bw() +
  labs(y = "SPI") +
  scale_y_continuous(breaks = seq(-4, 4, 1), limits = c(-4, 4)) +
  theme(legend.position = "bottom")  

如果您的目的是让丝带遵循

AREA

上斜坡，则需要根据插值（分数）

Date

值添加行。这不是不可能的，但要做更多的工作，我不确定您需要它。