在R的ggplot中实现潮汐渐变背景与每日微塑料浓度关联图

我需要用R的ggplot绘制一幅包含4天分面（facet_wrap）的图表，用来对比每日各采样时间点的微塑料浓度和潮汐数据。要求高潮对应深色渐变背景，低潮对应浅色渐变背景。参考日食背景渐变示例尝试时，因为潮汐数据依赖海拔值，出现了“离散值提供给连续刻度”（或反之）的错误。我可以从网站获取潮汐数据，但时间和采样时间不匹配；也可以手动在采样数据框中为对应时间添加水位数据，现在想请教如何把这些离散海拔值转换成4天对应的连续渐变背景。

以下是我尝试的代码：

high_tide_Day2LA = data.frame(start = as.POSIXct("2022-08-02 14:00:00"),
                      end = as.POSIXct("2022-08-02 15:00:00") )
tide_Day2LA = data.frame(start = as.POSIXct("2022-08-02 09:30:00"),
                         end = as.POSIXct("2022-08-02 15:20:00") )

color_dat_tideDay2LA = data.frame(time = seq(tide_Day2LA$start, tide_Day2LA$end, by = "1 min"))

color_dat_tideDay2LA = mutate(color_dat_tideDay2LA,
                   color = 0,
                   color = replace(color, 
                                   time < high_tide_Day2LA$start, 
                                   seq(100, 0, length.out = sum(time < high_tide_Day2LA$start) ) ),
                   color = replace(color, 
                                   time > high_tide_Day2LA$end, 
                                   seq(0, 100, length.out = sum(time > high_tide_Day2LA$end)) ) )

ggplot()+
  #geom_segment(data = color_dat_tideDay2LA,
               #aes(x = time, xend = time,
                  # y = -Inf, yend = Inf, color = color),
               #show.legend = FALSE)+
    #scale_color_gradient(low="lightblue",high="darkblue")+
  geom_point(data=df, aes(x=Date_time, y=MPs.m.3, shape=Location, colour=Location))+
  geom_line(data=df_loc, aes(x=Date_time, y=MPs.m.3, colour=Location))+
  geom_line(data=df_loc1, aes(x=Date_time, y=MPs.m.3, colour=Location))+
  scale_colour_manual(values = c("red", "purple"))+
  scale_y_continuous(limits = c(min(df$MPs.m.3), max(df$MPs.m.3)))+
  theme(panel.spacing = unit(1, "lines"), panel.grid.minor.x = element_blank() )+
  labs(x = "Dates and time of field work campaign", y = "MPs concentration per sample (MPs/m^3)")+
  facet_wrap(vars(Day), scales = "free_x", nrow = 4)

1. 构建全时段连续潮汐背景数据集 #

先为4天分别定义潮汐时段（低潮起始、高潮起止、低潮结束），再生成1分钟间隔的连续时间序列，对应计算潮汐强度值（0=低潮，100=高潮，中间线性渐变），最后合并成关联分面Day变量的总数据集。

library(dplyr)
library(ggplot2)
library(lubridate)

# 定义4天的潮汐参数（替换为你的实际时间）
tide_days <- list(
  Day1 = list(
    low_start = ymd_hms("2022-08-01 06:00:00"),
    high_start = ymd_hms("2022-08-01 12:00:00"),
    high_end = ymd_hms("2022-08-01 13:00:00"),
    low_end = ymd_hms("2022-08-01 18:00:00"),
    day_label = "Day1"
  ),
  Day2 = list(
    low_start = ymd_hms("2022-08-02 09:30:00"),
    high_start = ymd_hms("2022-08-02 14:00:00"),
    high_end = ymd_hms("2022-08-02 15:00:00"),
    low_end = ymd_hms("2022-08-02 15:20:00"),
    day_label = "Day2"
  ),
  Day3 = list(
    # 添加Day3的潮汐时间参数
    day_label = "Day3"
  ),
  Day4 = list(
    # 添加Day4的潮汐时间参数
    day_label = "Day4"
  )
)

# 批量生成单天潮汐背景数据的函数
build_tide_bg <- function(tide_info) {
  time_seq <- seq(tide_info$low_start, tide_info$low_end, by = "1 min")
  tide_intensity <- case_when(
    # 低潮到高潮：强度从0线性升到100
    time_seq < tide_info$high_start ~ seq(0, 100, length.out = sum(time_seq < tide_info$high_start)),
    # 高潮时段：强度保持100
    between(time_seq, tide_info$high_start, tide_info$high_end) ~ 100,
    # 高潮到低潮：强度从100线性降到0
    time_seq > tide_info$high_end ~ seq(100, 0, length.out = sum(time_seq > tide_info$high_end))
  )
  data.frame(
    Date_time = time_seq,
    tide_intensity = tide_intensity,
    Day = tide_info$day_label
  )
}

# 合并4天的背景数据
tide_bg_data <- bind_rows(lapply(tide_days, build_tide_bg))

2. 绘制分面图并添加渐变背景 #

用geom_tile绘制背景（比geom_segment更高效），将背景图层放在最底层，通过Day变量匹配分面，同时避免刻度冲突：

ggplot() +
  # 潮汐渐变背景（alpha调整透明度，避免遮盖数据）
  geom_tile(data = tide_bg_data, 
            aes(x = Date_time, y = Inf, height = Inf, fill = tide_intensity),
            alpha = 0.3, show.legend = FALSE) +
  scale_fill_gradient(low = "lightblue", high = "darkblue") +
  # 绘制微塑料浓度数据
  geom_point(data = df, aes(x = Date_time, y = MPs.m.3, shape = Location, colour = Location)) +
  geom_line(data = df_loc, aes(x = Date_time, y = MPs.m.3, colour = Location)) +
  geom_line(data = df_loc1, aes(x = Date_time, y = MPs.m.3, colour = Location)) +
  scale_colour_manual(values = c("red", "purple")) +
  scale_y_continuous(limits = c(min(df$MPs.m.3), max(df$MPs.m.3))) +
  theme(panel.spacing = unit(1, "lines"), panel.grid.minor.x = element_blank()) +
  labs(x = "野外采样日期与时间", y = "微塑料浓度 (MPs/m³)") +
  facet_wrap(vars(Day), scales = "free_x", nrow = 4)

3. 处理离散水位数据的方法 #

如果是手动添加的离散水位值，用approx函数插值成连续时间序列的强度值，避免离散/连续刻度错误：

# 示例：离散水位数据（时间+水位值，0=低潮，5=高潮）
discrete_tide <- data.frame(
  Date_time = ymd_hms(c("2022-08-02 09:30:00", "2022-08-02 14:00:00", "2022-08-02 15:00:00", "2022-08-02 15:20:00")),
  water_level = c(0, 5, 5, 0)
)

# 插值为1分钟间隔的连续数据
continuous_tide <- approx(discrete_tide$Date_time, discrete_tide$water_level, 
                          xout = seq(min(discrete_tide$Date_time), max(discrete_tide$Date_time), by = "1 min"))

# 转换为背景数据集（关联Day变量）
tide_bg_day2 <- data.frame(
  Date_time = continuous_tide$x,
  tide_intensity = continuous_tide$y, # 直接用水位值作为强度，或归一化到0-100
  Day = "Day2"
)

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