如何在R中实现data.table精准匹配物种、树龄+模糊匹配产量的关联？

我正在使用两个data.table：

• 基于多种林分条件的树龄-预测产量数据集；
• 特定地块带实测树龄的产量测量数据集。

希望找到最贴合实测产量的产量曲线，但当前代码运行后出现物种（species）、树龄（age）不匹配的情况，需要修改关联逻辑，强制精准匹配species.x == species.y与age.x == age.y，再基于产量（yield）进行模糊匹配。

原代码如下：

library (fuzzyjoin)
library(data.table)
library(ggplot2)

# set up some dummy yield curves
species <- c("a", "b") 
age <- seq(0:120)
s <- 10:12 # site difference
yield_db <- data.table(expand.grid(species=species, s=s, age=age))[
  order(species, age, s)]
yield_db[species=="a", yield := 1.5*age+age*s*3]
yield_db[species=="b", yield := 0.75*age+age*s*2]
yield_db[, yc_id := .GRP, by = .(species, s)] # add a unique identifier

# generate some measurements - just add some noise to some sample yields
set.seed(1)
num_rows <- 3  # Set the desired number of rows
measurement_db <- yield_db[age>20][sample(.N,num_rows)]
measurement_db[,yield:=yield+runif(num_rows, min=-40, max=40)]
measurement_db[,age:=age+round(runif(num_rows, min=-5, max=5),0)]

# Plot the "measurements" against "yields"
ggplot(data = yield_db, aes(x=age, y=yield, colour=as.factor(yc_id))) +
  geom_line() +
  geom_point(data=measurement_db, aes(x=age, y=yield), colour="orange")

# Join to nearest yield
res <- difference_left_join(
  measurement_db,
  yield_db,
  by=c("yield")
)

原输出存在物种、树龄不匹配问题：

> res
  species.x s.x age.x  yield.x yc_id.x species.y s.y age.y yield.y yc_id.y
1         a  12    60 2375.364       3         b  12    96 2376.00       6
2         b  11    86 2035.079       5         a  11    59 2035.50       2
3         b  12    78 1845.943       6         b  10    89 1846.75       4

方法1：利用data.table分组匹配（高效直观） #

直接对每个实测记录，筛选同物种同树龄的预测数据，再取产量差异最小的记录：

# 修改后的关联逻辑：精准匹配species和age，再找同组内最接近的yield
res <- measurement_db[, {
  curr_sp <- species
  curr_age <- age
  curr_yield <- yield
  # 筛选同物种同树龄的预测记录，计算产量差并取最小的那条
  matched <- yield_db[species == curr_sp & age == curr_age, 
                      .(species.y = species, s.y = s, age.y = age, yield.y = yield, yc_id.y = yc_id, 
                        diff = abs(yield - curr_yield))][order(diff)][1]
  # 合并当前实测记录与匹配结果
  cbind(.SD, matched)
}, by = .(species, age)]

# 移除临时差异列（可选）
res[, diff := NULL]

运行结果示例：

> res
   species age s.x yield.x yc_id.x species.y s.y age.y yield.y yc_id.y
1:       a  60  12 2375.364       3         a  12    60 2268.00       3
2:       b  86  11 2035.079       5         b  12    86 1962.90       6
3:       b  78  12 1845.943       6         b  12    78 1794.60       6

方法2：结合fuzzyjoin的多条件匹配 #

使用difference_left_join的match_fun参数，指定species和age为精准匹配，再对yield做模糊匹配，最后筛选每个实测记录的最小差异结果：

res <- difference_left_join(
  measurement_db,
  yield_db,
  by = c("species", "age", "yield"),
  # 前两个条件精准匹配，第三个允许产量差异
  match_fun = list(`==`, `==`, function(x, y) TRUE),
  max_dist = Inf
)

# 对每个实测记录，筛选产量差异最小的匹配结果
res <- res[, .SD[which.min(abs(yield.x - yield.y))], by = .(species.x, age.x, yield.x)]

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