如何匹配不同长度垂直剖面首尾并插值中间（R语言实现）

需求说明 #

我用R处理土壤芯分段测量的剖面数据，芯体按20cm分段，但长度未必是20的倍数，分段从顶底两端开始，差异集中在中间不关注的区域。不同分析的芯体长度不完全匹配，有的多1-2段。现在要针对同一采样日的芯体，匹配顶部和底部的剖面段，中间部分用线性插值补全，生成分段中点的统一值。

原始数据 #

df <- structure(
  list(
    Sample_Day = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1),
    Top = c(102, 82, 62, 42, 20, 110, 90, 70, 50, 40, 20),
    Bottom = c(82, 62, 42, 22, 0, 90, 70, 50, 40, 20, 0),
    Section_Length = c(20, 20, 20, 20, 20, 20, 20, 20, 10, 20, 20),
    Parameter = c("Temp", "Temp", "Temp", "Temp", "Temp", "Chemical", "Chemical", "Chemical", "Chemical", "Chemical", "Chemical"),
    Value = c(10, 6, 4, 2, 1, 1, 2, 3, 2, 1, 1),
    Index = c(1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 6)
  ),
  row.names = c(NA, -11L),
  class = "data.frame"
)

# 输出预览
#    Sample_Day Top Bottom Section_Length Parameter Value Index
# 1           1 102     82             20      Temp    10     1
# 2           1  82     62             20      Temp     6     2
# 3           1  62     42             20      Temp     4     3
# 4           1  42     22             20      Temp     2     4
# 5           1  20      0             20      Temp     1     5
# 6           1 110     90             20  Chemical     1     1
# 7           1  90     70             20  Chemical     2     2
# 8           1  70     50             20  Chemical     3     3
# 9           1  50     40             10  Chemical     2     4
# 10          1  40     20             20  Chemical     1     5
# 11          1  20      0             20  Chemical     1     6

期望结果 #

target <- structure(
  list(
    Sample_Day = c(1, 1, 1, 1, 1, 1),
    Top = c(110, 90, 70, 50, 40, 20),
    Bottom = c(90, 70, 50, 40, 20, 0),
    Section_Length = c(20, 20, 20, 10, 20, 20),
    Temp = c(10, 6, 4, 3, 2, 1),
    Chemical = c(1, 2, 3, 2, 1, 1),
    Index = c(1, 2, 3, 4, 5, 6)
  ),
  row.names = c(NA, -6L),
  class = "data.frame"
)

# 输出预览
#   Sample_Day Top Bottom Section_Length Temp Chemical Index
# 1          1 110     90             20   10        1     1
# 2          1  90     70             20    6        2     2
# 3          1  70     50             20    4        3     3
# 4          1  50     40             10    3        2     4
# 5          1  40     20             20    2        1     5
# 6          1  20      0             20    1        1     6

实现思路与代码 #

核心思路是用实际深度中点作为插值基准，而不是依赖Index，这样能避免不同参数分段不匹配的问题。以下是基于tidyverse的实现代码：

library(tidyverse)

# 1. 计算每个分段的深度中点
df <- df %>% mutate(Mid = (Top + Bottom)/2)

# 2. 按采样日分组处理，批量完成插值与合并
result <- df %>%
  group_by(Sample_Day) %>%
  group_modify(function(.data, .key) {
    # 选取分段最多的参数作为基准剖面（这里是Chemical）
    ref_profile <- .data %>% 
      filter(Parameter == "Chemical") %>% 
      arrange(Mid)  # 按深度从深到浅排序
    
    # 对每个参数进行线性插值，匹配基准剖面的深度点
    interpolated_params <- map(unique(.data$Parameter), function(param) {
      param_data <- .data %>% 
        filter(Parameter == param) %>% 
        arrange(Mid)
      
      # 用R基础函数approx做线性插值
      interp_values <- approx(
        x = param_data$Mid, 
        y = param_data$Value, 
        xout = ref_profile$Mid,
        rule = 2  # 保留首尾边界值，符合顶底匹配需求
      )$y
      
      tibble(!!param := interp_values)
    }) %>% bind_cols()
    
    # 合并基准剖面的结构信息与插值结果
    bind_cols(ref_profile %>% select(-Parameter, -Value), interpolated_params)
  }) %>% ungroup()

# 查看最终结果
print(result)

代码关键点说明 #

• 深度中点(Mid)：作为插值的x轴，确保不同参数的分段能基于实际深度对齐，解决Index不匹配的问题。
• group_modify：批量处理每个采样日的数据集，避免重复代码。
• approx函数：R基础包的线性插值工具，rule=2确保顶底的边界值不会被插值覆盖，符合需求中“匹配顶部和底部部分”的要求。
• 动态列绑定：通过map+bind_cols实现宽格式转换，将不同参数的值合并到同一行。

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