R基于具有添加条件的特定列合并两个数据集
Posted
技术标签:
【中文标题】R基于具有添加条件的特定列合并两个数据集【英文标题】：R merge two datasets based on specific columns with added condition 【发布时间】：2020-09-15 21:38:03 【问题描述】：Uwe 和 GKi 的答案都是正确的。 Gki 收到赏金是因为 Uwe 迟到了，但 Uwe 的解决方案运行速度大约是 15 倍
我有两个数据集，其中包含不同患者在多个测量时刻的得分，如下所示：
df1 <- data.frame("ID" = c("patient1","patient1","patient1","patient1","patient2","patient3"),
"Days" = c(0,25,235,353,100,538),
"Score" = c(NA,2,3,4,5,6),
stringsAsFactors = FALSE)
df2 <- data.frame("ID" = c("patient1","patient1","patient1","patient1","patient2","patient2","patient3"),
"Days" = c(0,25,248,353,100,150,503),
"Score" = c(1,10,3,4,5,7,6),
stringsAsFactors = FALSE)
> df1
ID Days Score
1 patient1 0 NA
2 patient1 25 2
3 patient1 235 3
4 patient1 353 4
5 patient2 100 5
6 patient3 538 6
> df2
ID Days Score
1 patient1 0 1
2 patient1 25 10
3 patient1 248 3
4 patient1 353 4
5 patient2 100 5
6 patient2 150 7
7 patient3 503 6
ID 列显示患者 ID，Days 列显示测量时刻（患者纳入后的天数），Score 列显示测量得分。两个数据集都显示相同的数据，但时间不同（df1 是 2 年前，df2 具有相同的数据，但从今年开始更新）。
我必须比较两个数据集之间每个患者和每个时刻的得分。但是，在某些情况下，Days 变量会随着时间的推移而发生细微的变化，因此通过简单的连接来比较数据集是行不通的。示例：
library(dplyr)
> full_join(df1, df2, by=c("ID","Days")) %>%
+ arrange(.[[1]], as.numeric(.[[2]]))
ID Days Score.x Score.y
1 patient1 0 NA 1
2 patient1 25 2 10
3 patient1 235 3 NA
4 patient1 248 NA 3
5 patient1 353 4 4
6 patient2 100 5 5
7 patient2 150 NA 7
8 patient3 503 NA 6
9 patient3 538 6 NA
此处，第 3 行和第 4 行包含相同测量的数据（得分为 3），但未连接，因为 Days 列的值不同（235 与 248）。
问题：我正在寻找一种在第二列（比如 30 天）上设置阈值的方法，这将导致以下输出：
> threshold <- 30
> *** insert join code ***
ID Days Score.x Score.y
1 patient1 0 NA 1
2 patient1 25 2 10
3 patient1 248 3 3
4 patient1 353 4 4
5 patient2 100 5 5
6 patient2 150 NA 7
7 patient3 503 NA 6
8 patient3 538 6 NA
此输出显示前一个输出的第 3 行和第 4 行已合并（因为 248-235 Days 的值。
要记住的三个主要条件是：
在同一 df（第 1 行和第 2 行）内的阈值内的连续天数不会合并。 在某些情况下，Days 变量的最多四个值存在于同一数据框中，因此不应合并。可能这些值之一确实存在于另一个数据帧的阈值中，并且必须合并这些值。请参阅下面示例中的第 3 行。
每个分数/天数/患者组合只能使用一次。如果合并满足所有条件，但仍有可能进行双重合并，则应使用第一个。
> df1
ID Days Score
1 patient1 0 1
2 patient1 5 2
3 patient1 10 3
4 patient1 15 4
5 patient1 50 5
> df2
ID Days Score
1 patient1 0 1
2 patient1 5 2
3 patient1 12 3
4 patient1 15 4
5 patient1 50 5
> df_combined
ID Days Score.x Score.y
1 patient1 0 1 1
2 patient1 5 2 2
3 patient1 12 3 3
4 patient1 15 4 4
5 patient1 50 5 5
为 CHINSOON12 编辑
> df1
ID Days Score
1: patient1 0 1
2: patient1 116 2
3: patient1 225 3
4: patient1 309 4
5: patient1 351 5
6: patient2 0 6
7: patient2 49 7
> df2
ID Days Score
1: patient1 0 11
2: patient1 86 12
3: patient1 195 13
4: patient1 279 14
5: patient1 315 15
6: patient2 0 16
7: patient2 91 17
8: patient2 117 18
我将您的解决方案包装在这样的函数中：
testSO2 <- function(DT1,DT2)
setDT(DT1);setDT(DT2)
names(DT1) <- c("ID","Days","X")
names(DT2) <- c("ID","Days","Y")
DT1$Days <- as.numeric(DT1$Days)
DT2$Days <- as.numeric(DT2$Days)
DT1[, c("s1", "e1", "s2", "e2") := .(Days - 30L, Days + 30L, Days, Days)]
DT2[, c("s1", "e1", "s2", "e2") := .(Days, Days, Days - 30L, Days + 30L)]
byk <- c("ID", "s1", "e1")
setkeyv(DT1, byk)
setkeyv(DT2, byk)
o1 <- foverlaps(DT1, DT2)
byk <- c("ID", "s2", "e2")
setkeyv(DT1, byk)
setkeyv(DT2, byk)
o2 <- foverlaps(DT2, DT1)
olaps <- funion(o1, setcolorder(o2, names(o1)))[
is.na(Days), Days := i.Days]
outcome <- olaps[,
if (all(!is.na(Days)) && any(Days == i.Days))
s <- .SD[Days == i.Days, .(Days = Days[1L],
X = X[1L],
Y = Y[1L])]
else
s <- .SD[, .(Days = max(Days, i.Days), X, Y)]
unique(s)
,
keyby = .(ID, md = pmax(Days, i.Days))][, md := NULL][]
return(outcome)
结果：
> testSO2(df1,df2)
ID Days X Y
1: patient1 0 1 11
2: patient1 116 2 12
3: patient1 225 3 13
4: patient1 309 4 14
5: patient1 315 4 15
6: patient1 351 5 NA
7: patient2 0 6 16
8: patient2 49 7 NA
9: patient2 91 NA 17
10: patient2 117 NA 18
如您所见，第 4 行和第 5 行是错误的。 df1 中Score 的值被使用了两次 (4)。这些行周围的正确输出应如下所示，因为每个分数（在本例中为 X 或 Y）只能使用一次：
ID Days X Y
4: patient1 309 4 14
5: patient1 315 NA 15
6: patient1 351 5 NA
以下数据框的代码。
> dput(df1)
structure(list(ID = c("patient1", "patient1", "patient1", "patient1",
"patient1", "patient2", "patient2"), Days = c("0", "116", "225",
"309", "351", "0", "49"), Score = 1:7), row.names = c(NA, 7L), class = "data.frame")
> dput(df2)
structure(list(ID = c("patient1", "patient1", "patient1", "patient1",
"patient1", "patient2", "patient2", "patient2"), Days = c("0",
"86", "195", "279", "315", "0", "91", "117"), Score = 11:18), row.names = c(NA,
8L), class = "data.frame")
【问题讨论】：
您是否尝试过采用不同的方法来解决问题？如果有一种方法可以标记测量所代表的内容，您可能会更好。您要求的解决方案容易因边缘情况而失败。 我必须在内容上比较许多不同的变量，所以标签并不是一个真正的选择。为了清楚起见，我在这里选择了一个数字分数，但实际上第 3 列的内容并不重要。第二列的合并是主要问题 这在您的数据集中没有发生，但是：如果在您的第一个连接数据集的第 3 行和第 4 行中，您会有Score.x = 3 和 Score.y = 4 怎么办？在这种情况下，您还想放弃其中一项测量吗？
如果我理解正确，测量值不会被丢弃。在 df1 中，测量值为 3，第 235 天，而在 df2 中，测量值为 4，第 248 天。在这种情况下，这些天将连接在一起，但测量不会，因此最终结果将是 patient1 248 3 4
知道了。后续问题：关于您的第一个连接数据框，如果您在第 1 行和第 2 行（称为第 1.5 行）之间有一行 ID = patient1、Days = 13、Score.x = 1 和 Score.y = NA，该怎么办？您是否只希望第 2 行与第 1.5 行合并，即使它仍在第 1 行的 30 天内？
【参考方案1】：
此代码允许您给出一个阈值，然后将 df1 中的分数合并到 df1 中作为一个新列。它只会添加落在 df2 +/- 阈值的单个分数范围内的分数。请注意，不可能将所有分数都连接起来，因为没有阈值可以让所有分数唯一匹配。
threshold <- 40
WhereDF1inDF2 <- apply(sapply(lapply(df2$Days, function(x) (x+threshold):(x-threshold)), function(y) df1$Days %in% y),1,which)
useable <- sapply(WhereDF1inDF2, function(x) length(x) ==1 )
df2$Score1 <- NA
df2$Score1[unlist(WhereDF1inDF2[useable])] <- df1$Score[useable]
> df2
ID Days Score Score1
1 patient1 0 1 NA
2 patient1 25 10 NA
3 patient1 248 3 3
4 patient1 353 4 4
5 patient2 100 5 5
6 patient2 150 7 NA
7 patient3 503 6 6
【讨论】：
【参考方案2】：这是一个可能的data.table 解决方案
library(data.table)
#convert df1 and df2 to data.table format
setDT(df1);setDT(df2)
#set colnames for later on
# (add .df1/.df2 suffix after Days and Score-colnamaes)
cols <- c("Days", "Score")
setnames(df1, cols, paste0( cols, ".df1" ) )
setnames(df2, cols, paste0( cols, ".df2" ) )
#update df1 with new measures from df2 (and df2 with df1)
# copies are made, to prevent changes in df1 and df2
dt1 <- copy(df1)[ df2, `:=`(Days.df2 = i.Days.df2, Score.df2 = i.Score.df2), on = .(ID, Days.df1 = Days.df2), roll = 30]
dt2 <- copy(df2)[ df1, `:=`(Days.df1 = i.Days.df1, Score.df1 = i.Score.df1), on = .(ID, Days.df2 = Days.df1), roll = -30]
#rowbind by columnnames (here the .df1/.df2 suffix is needed!), only keep unique rows
ans <- unique( rbindlist( list( dt1, dt2), use.names = TRUE ) )
#wrangle data to get to desired output
ans[, Days := ifelse( is.na(Days.df2), Days.df1, Days.df2 ) ]
ans <- ans[, .(Days, Score.x = Score.df1, Score.y = Score.df2 ), by = .(ID) ]
setkey( ans, ID, Days ) #for sorting; setorder() can also be used.
# ID Days Score.x Score.y
# 1: patient1 0 NA 1
# 2: patient1 25 2 10
# 3: patient1 248 3 3
# 4: patient1 353 4 4
# 5: patient2 100 5 5
# 6: patient2 150 NA 7
# 7: patient3 503 NA 6
# 8: patient3 538 6 NA
【讨论】：
这在我最初给出的示例中有效，但它不适用于任何真实数据（或其中的一部分，请参阅我帖子中的最新编辑）。它只会以某种方式正确地合并每个患者的第一个数据。【参考方案3】：听起来像是对现实但混乱的数据集进行的数据清理练习，不幸的是，我们大多数人以前都有过这种经验。这是另一个data.table 选项：
DT1[, c("Xrn", "s1", "e1", "s2", "e2") := .(.I, Days - 30L, Days + 30L, Days, Days)]
DT2[, c("Yrn", "s1", "e1", "s2", "e2") := .(.I, Days, Days, Days - 30L, Days + 30L)]
byk <- c("ID", "s1", "e1")
setkeyv(DT1, byk)
setkeyv(DT2, byk)
o1 <- foverlaps(DT1, DT2)
byk <- c("ID", "s2", "e2")
setkeyv(DT1, byk)
setkeyv(DT2, byk)
o2 <- foverlaps(DT2, DT1)
olaps <- funion(o1, setcolorder(o2, names(o1)))[
is.na(Days), Days := i.Days]
ans <- olaps[,
if (any(Days == i.Days))
.SD[Days == i.Days,
.(Days=Days[1L], Xrn=Xrn[1L], Yrn=Yrn[1L], X=X[1L], Y=Y[1L])]
else
.SD[, .(Days=md, Xrn=Xrn[1L], Yrn=Yrn[1L], X=X[1L], Y=Y[1L])]
,
keyby = .(ID, md = pmax(Days, i.Days))]
#or also ans[duplicated(Xrn), X := NA_integer_][duplicated(Yrn), Y := NA_integer_]
ans[rowid(Xrn) > 1L, X := NA_integer_]
ans[rowid(Yrn) > 1L, Y := NA_integer_]
ans[, c("md", "Xrn", "Yrn") := NULL][]
以下数据集的输出：
ID Days X Y
1: 1 0 1 11
2: 1 10 2 12
3: 1 25 3 13
4: 1 248 4 14
5: 1 353 5 15
6: 2 100 6 16
7: 2 150 NA 17
8: 3 503 NA 18
9: 3 538 7 NA
OP 编辑中第二个数据集的输出：
ID Days X Y
1: patient1 0 1 11
2: patient1 116 2 12
3: patient1 225 3 13
4: patient1 309 4 14
5: patient1 315 NA 15
6: patient1 351 5 NA
7: patient2 0 6 16
8: patient2 49 7 NA
9: patient2 91 NA 17
10: patient2 117 NA 18
数据（我从其他链接的帖子中添加了更多数据，并简化了数据以便于查看）：
library(data.table)
DT1 <- data.table(ID = c(1,1,1,1,1,2,3),
Days = c(0,10,25,235,353,100,538))[, X := .I]
DT2 <- data.table(ID = c(1,1,1,1,1,2,2,3),
Days = c(0,10,25,248,353,100,150,503))[, Y := .I + 10L]
解释：
依次使用每个表作为左表执行 2 次重叠连接。
将右表中设置 NA 天之前的 2 个结果与左表中的结果合并。
按患者和重叠日期分组。如果存在相同的日期，则保留记录。否则使用最大日期。
每个分数只能使用一次，因此删除重复项。
如果您发现这种方法没有给出正确结果的情况，请告诉我。
【讨论】：
这是迄今为止最好的。我在我的数据样本上对其进行了测试，只有 1 个错误。我会在我的帖子中编辑它 @BorisRuwe，我添加了一些代码以防止重复使用分数。如果您发现更多这种方法错误的情况，请告诉我。 仍有问题出现；如果插入新的时刻，Xrn 和 Yrn 行值会不同步，因此ans[rowid(X) > 1L, X := NA_integer_] 中的大量数据设置为 NA。你有时间聊天吗？ chat.***.com/rooms/215510/…【参考方案4】：
以下代码适用于您的示例数据。根据您的条件，它应该适用于您的完整数据。对于其他异常，您可以调整df31和df32。
df1 <- data.frame("ID" = c("patient1","patient1","patient1","patient1","patient2","patient3"),
"Days1" = c(0,25,235,353,100,538),
"Score1" = c(NA,2,3,4,5,6),
stringsAsFactors = FALSE)
df2 <- data.frame("ID" = c("patient1","patient1","patient1","patient1","patient2","patient2","patient3"),
"Days2" = c(0,25,248,353,100,150,503),
"Score2" = c(1,10,3,4,5,7,6),
stringsAsFactors = FALSE)
## define a dummy sequence for each patient
df11 <- df1 %>% group_by(ID) %>% mutate(ptseq = row_number())
df21 <- df2 %>% group_by(ID) %>% mutate(ptseq = row_number())
df3 <- dplyr::full_join(df11, df21, by=c("ID","ptseq")) %>%
arrange(.[[1]], as.numeric(.[[2]]))
df31 <- df3 %>% mutate(Days=Days2, diff=Days1-Days2) %>%
mutate(Score1=ifelse(abs(diff)>30, NA, Score1))
df32 <- df3 %>% mutate(diff=Days1-Days2) %>%
mutate(Days = case_when(abs(diff)>30 ~ Days1), Score2=c(NA), Days2=c(NA)) %>%
subset(!is.na(Days))
df <- rbind(df31,df32) %>% select(ID, ptseq, Days, Score1, Score2) %>%
arrange(.[[1]], as.numeric(.[[2]])) %>% select(-2)
>df
ID Days Score1 Score2
<chr> <dbl> <dbl> <dbl>
1 patient1 0 NA 1
2 patient1 25 2 10
3 patient1 248 3 3
4 patient1 353 4 4
5 patient2 100 5 5
6 patient2 150 NA 7
7 patient3 503 NA 6
8 patient3 538 6 NA
【讨论】：
这段代码在更大的样本数据集中为Days 留下了很多双精度值。我将尝试对其进行编辑以使其正常工作
我通过添加df %>% group_by(ID, Days) %>% mutate(Score.xx = dplyr::first(na.omit(Score.x)), Score.yy = dplyr::first(na.omit(Score.y))) %>% select(-Score.x,-Score.y) %>% unique() 解决了这个问题。不幸的是，当在我的真实数据中的 1000 行样本上使用您的代码时，只剩下 75 个非 NA 值（在 86 个中），所以仍然有问题。
这意味着上面的示例数据中没有显示其他一些异常。也许您可以提供一个新的代表或描述其他例外情况。【参考方案5】：
base 解决方案使用lapply 来查找Days 中的差异低于阈值 的位置，并使用expand.grid 来获得所有可能组合。然后删除那些会选择两次或在另一个后面选择的那些。从这些计算日差并选择具有连续最低差的行。之后rbind df2 不匹配。
threshold <- 30
nmScore <- threshold
x <- do.call(rbind, lapply(unique(c(df1$ID, df2$ID)), function(ID)
x <- df1[df1$ID == ID,]
y <- df2[df2$ID == ID,]
if(nrow(x) == 0) return(data.frame(ID=ID, y[1,-1][NA,], y[,-1]))
if(nrow(y) == 0) return(data.frame(ID=ID, x[,-1], x[1,-1][NA,]))
x <- x[order(x$Days),]
y <- y[order(y$Days),]
z <- do.call(expand.grid, lapply(x$Days, function(z) c(NA,
which(abs(z - y$Days) < threshold))))
z <- z[!apply(z, 1, function(z) anyDuplicated(z[!is.na(z)]) > 0 ||
any(diff(z[!is.na(z)]) < 1)), , drop = FALSE]
s <- as.data.frame(sapply(seq_len(ncol(z)), function(j)
abs(x$Days[j] - y$Days[z[,j]])))
s[is.na(s)] <- nmScore
s <- matrix(apply(s, 1, sort), nrow(s), byrow = TRUE)
i <- rep(TRUE, nrow(s))
for(j in seq_len(ncol(s))) i[i] <- s[i,j] == min(s[i,j])
i <- unlist(z[which.max(i),])
j <- setdiff(seq_len(nrow(y)), i)
rbind(data.frame(ID=ID, x[,-1], y[i, -1]),
if(length(j) > 0) data.frame(ID=ID, x[1,-1][NA,], y[j, -1], row.names=NULL))
))
x <- x[order(x[,1], ifelse(is.na(x[,2]), x[,4], x[,2])),]
数据：
0..Boris Ruwe 的第一个测试用例， 来自 Boris Ruwe 的 1..2nd 测试用例， 来自 Boris Ruwe 的 2..3nd 测试用例， 3..Uwe的测试用例， 4..来自R rolling join two data.tables with error margin on join 的 Boris Ruwe 的测试用例， 5..来自 GKi 的测试用例。
df1 <- structure(list(ID = c("0patient1", "0patient1", "0patient1",
"0patient1", "0patient2", "0patient3", "1patient1", "1patient1",
"1patient1", "1patient1", "1patient1", "2patient1", "2patient1",
"2patient1", "2patient1", "2patient1", "2patient2", "2patient2",
"3patient1", "3patient1", "3patient1", "3patient1", "3patient1",
"3patient1", "3patient2", "3patient3", "4patient1", "4patient1",
"4patient1", "4patient1", "4patient2", "4patient3", "5patient1",
"5patient1", "5patient1", "5patient2"), Days = c(0, 25, 235,
353, 100, 538, 0, 5, 10, 15, 50, 0, 116, 225, 309, 351, 0, 49,
0, 1, 25, 235, 237, 353, 100, 538, 0, 10, 25, 340, 100, 538,
3, 6, 10, 1), Score = c(NA, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 1,
2, 3, 4, 5, 6, 7, NA, 2, 3, 4, 5, 6, 7, 8, NA, 2, 3, 99, 5, 6,
1, 2, 3, 1)), row.names = c(NA, -36L), class = "data.frame")
df2 <- structure(list(ID = c("0patient1", "0patient1", "0patient1",
"0patient1", "0patient2", "0patient2", "0patient3", "1patient1",
"1patient1", "1patient1", "1patient1", "1patient1", "2patient1",
"2patient1", "2patient1", "2patient1", "2patient1", "2patient2",
"2patient2", "2patient2", "3patient1", "3patient1", "3patient1",
"3patient1", "3patient1", "3patient1", "3patient2", "3patient2",
"3patient3", "4patient1", "4patient1", "4patient1", "4patient1",
"4patient2", "4patient2", "4patient3", "5patient1", "5patient1",
"5patient1", "5patient3"), Days = c(0, 25, 248, 353, 100, 150,
503, 0, 5, 12, 15, 50, 0, 86, 195, 279, 315, 0, 91, 117, 0, 25,
233, 234, 248, 353, 100, 150, 503, 0, 10, 25, 353, 100, 150,
503, 1, 4, 8, 1), Score = c(1, 10, 3, 4, 5, 7, 6, 1, 2, 3, 4,
5, 11, 12, 13, 14, 15, 16, 17, 18, 11, 12, 13, 14, 15, 16, 17,
18, 19, 1, 10, 3, 4, 5, 7, 6, 11, 12, 13, 1)), row.names = c(NA,
-40L), class = "data.frame")
df1
# ID Days Score
#1 0patient1 0 NA
#2 0patient1 25 2
#3 0patient1 235 3
#4 0patient1 353 4
#5 0patient2 100 5
#6 0patient3 538 6
#7 1patient1 0 1
#8 1patient1 5 2
#9 1patient1 10 3
#10 1patient1 15 4
#11 1patient1 50 5
#12 2patient1 0 1
#13 2patient1 116 2
#14 2patient1 225 3
#15 2patient1 309 4
#16 2patient1 351 5
#17 2patient2 0 6
#18 2patient2 49 7
#19 3patient1 0 NA
#20 3patient1 1 2
#21 3patient1 25 3
#22 3patient1 235 4
#23 3patient1 237 5
#24 3patient1 353 6
#25 3patient2 100 7
#26 3patient3 538 8
#27 4patient1 0 NA
#28 4patient1 10 2
#29 4patient1 25 3
#30 4patient1 340 99
#31 4patient2 100 5
#32 4patient3 538 6
#33 5patient1 3 1
#34 5patient1 6 2
#35 5patient1 10 3
#36 5patient2 1 1
df2
# ID Days Score
#1 0patient1 0 1
#2 0patient1 25 10
#3 0patient1 248 3
#4 0patient1 353 4
#5 0patient2 100 5
#6 0patient2 150 7
#7 0patient3 503 6
#8 1patient1 0 1
#9 1patient1 5 2
#10 1patient1 12 3
#11 1patient1 15 4
#12 1patient1 50 5
#13 2patient1 0 11
#14 2patient1 86 12
#15 2patient1 195 13
#16 2patient1 279 14
#17 2patient1 315 15
#18 2patient2 0 16
#19 2patient2 91 17
#20 2patient2 117 18
#21 3patient1 0 11
#22 3patient1 25 12
#23 3patient1 233 13
#24 3patient1 234 14
#25 3patient1 248 15
#26 3patient1 353 16
#27 3patient2 100 17
#28 3patient2 150 18
#29 3patient3 503 19
#30 4patient1 0 1
#31 4patient1 10 10
#32 4patient1 25 3
#33 4patient1 353 4
#34 4patient2 100 5
#35 4patient2 150 7
#36 4patient3 503 6
#37 5patient1 1 11
#38 5patient1 4 12
#39 5patient1 8 13
#40 5patient3 1 1
结果：
# ID Days Score Days.1 Score.1
#1 0patient1 0 NA 0 1
#2 0patient1 25 2 25 10
#3 0patient1 235 3 248 3
#4 0patient1 353 4 353 4
#5 0patient2 100 5 100 5
#110 0patient2 NA NA 150 7
#111 0patient3 NA NA 503 6
#6 0patient3 538 6 NA NA
#7 1patient1 0 1 0 1
#8 1patient1 5 2 5 2
#9 1patient1 10 3 12 3
#10 1patient1 15 4 15 4
#11 1patient1 50 5 50 5
#12 2patient1 0 1 0 11
#112 2patient1 NA NA 86 12
#13 2patient1 116 2 NA NA
#210 2patient1 NA NA 195 13
#14 2patient1 225 3 NA NA
#37 2patient1 NA NA 279 14
#15 2patient1 309 4 315 15
#16 2patient1 351 5 NA NA
#17 2patient2 0 6 0 16
#18 2patient2 49 7 NA NA
#113 2patient2 NA NA 91 17
#211 2patient2 NA NA 117 18
#19 3patient1 0 NA 0 11
#20 3patient1 1 2 NA NA
#21 3patient1 25 3 25 12
#114 3patient1 NA NA 233 13
#22 3patient1 235 4 234 14
#23 3patient1 237 5 248 15
#24 3patient1 353 6 353 16
#25 3patient2 100 7 100 17
#115 3patient2 NA NA 150 18
#116 3patient3 NA NA 503 19
#26 3patient3 538 8 NA NA
#27 4patient1 0 NA 0 1
#28 4patient1 10 2 10 10
#29 4patient1 25 3 25 3
#30 4patient1 340 99 353 4
#31 4patient2 100 5 100 5
#117 4patient2 NA NA 150 7
#118 4patient3 NA NA 503 6
#32 4patient3 538 6 NA NA
#119 5patient1 NA NA 1 11
#33 5patient1 3 1 4 12
#34 5patient1 6 2 8 13
#35 5patient1 10 3 NA NA
#36 5patient2 1 1 NA NA
#NA 5patient3 NA NA 1 1
格式化结果：
data.frame(ID=x[,1], Days=ifelse(is.na(x[,2]), x[,4], x[,2]),
Score.x=x[,3], Score.y=x[,5])
# ID Days Score.x Score.y
#1 0patient1 0 NA 1
#2 0patient1 25 2 10
#3 0patient1 235 3 3
#4 0patient1 353 4 4
#5 0patient2 100 5 5
#6 0patient2 150 NA 7
#7 0patient3 503 NA 6
#8 0patient3 538 6 NA
#9 1patient1 0 1 1
#10 1patient1 5 2 2
#11 1patient1 10 3 3
#12 1patient1 15 4 4
#13 1patient1 50 5 5
#14 2patient1 0 1 11
#15 2patient1 86 NA 12
#16 2patient1 116 2 NA
#17 2patient1 195 NA 13
#18 2patient1 225 3 NA
#19 2patient1 279 NA 14
#20 2patient1 309 4 15
#21 2patient1 351 5 NA
#22 2patient2 0 6 16
#23 2patient2 49 7 NA
#24 2patient2 91 NA 17
#25 2patient2 117 NA 18
#26 3patient1 0 NA 11
#27 3patient1 1 2 NA
#28 3patient1 25 3 12
#29 3patient1 233 NA 13
#30 3patient1 235 4 14
#31 3patient1 237 5 15
#32 3patient1 353 6 16
#33 3patient2 100 7 17
#34 3patient2 150 NA 18
#35 3patient3 503 NA 19
#36 3patient3 538 8 NA
#37 4patient1 0 NA 1
#38 4patient1 10 2 10
#39 4patient1 25 3 3
#40 4patient1 340 99 4
#41 4patient2 100 5 5
#42 4patient2 150 NA 7
#43 4patient3 503 NA 6
#44 4patient3 538 6 NA
#45 5patient1 1 NA 11
#46 5patient1 3 1 12
#47 5patient1 6 2 13
#48 5patient1 10 3 NA
#49 5patient2 1 1 NA
#50 5patient3 1 NA 1
获取Days的备选方案：
#From df1 and in case it is NA I took it from df2
data.frame(ID=x[,1], Days=ifelse(is.na(x[,2]), x[,4], x[,2]),
Score.x=x[,3], Score.y=x[,5])
#From df2 and in case it is NA I took it from df1
data.frame(ID=x[,1], Days=ifelse(is.na(x[,4]), x[,2], x[,4]),
Score.x=x[,3], Score.y=x[,5])
#Mean
data.frame(ID=x[,1], Days=rowMeans(x[,c(2,4)], na.rm=TRUE),
Score.x=x[,3], Score.y=x[,5])
如果应尽量减少总天的差异，允许不采用最近的，一种可能的方法是：
threshold <- 30
nmScore <- threshold
x <- do.call(rbind, lapply(unique(c(df1$ID, df2$ID)), function(ID)
x <- df1[df1$ID == ID,]
y <- df2[df2$ID == ID,]
x <- x[order(x$Days),]
y <- y[order(y$Days),]
if(nrow(x) == 0) return(data.frame(ID=ID, y[1,-1][NA,], y[,-1]))
if(nrow(y) == 0) return(data.frame(ID=ID, x[,-1], x[1,-1][NA,]))
z <- do.call(expand.grid, lapply(x$Days, function(z) c(NA,
which(abs(z - y$Days) < threshold))))
z <- z[!apply(z, 1, function(z) anyDuplicated(z[!is.na(z)]) > 0 ||
any(diff(z[!is.na(z)]) < 1)), , drop = FALSE]
s <- as.data.frame(sapply(seq_len(ncol(z)), function(j)
abs(x$Days[j] - y$Days[z[,j]])))
s[is.na(s)] <- nmScore
i <- unlist(z[which.min(rowSums(s)),])
j <- setdiff(seq_len(nrow(y)), i)
rbind(data.frame(ID=ID, x[,-1], y[i, -1]),
if(length(j) > 0) data.frame(ID=ID, x[1,-1][NA,], y[j, -1], row.names=NULL))
))
x <- x[order(x[,1], ifelse(is.na(x[,2]), x[,4], x[,2])),]
【讨论】：
它似乎有效，目前正在对更大的数据集进行测试。同时我收到一些我不太明白的警告，你能详细说明一下吗？警告 1：24: In min(z) : no non-missing arguments to min; returning Inf 警告 2：25: In data.frame(..., check.names = FALSE) : row names were found from a short variable and have been discarded
我还没有发现错误，所以我现在将接受这个作为答案。非常感谢！还有一件事，Days 值是否可以使用 df2 的值，而不是像现在这样使用最高值？
目前我从df1 获取Days，如果是NA，我从df2 获取它。您想从df2 获取它们，如果它们是NA，从df1 获取它们？ x 包含这两个信息。第一个块是df1，第二个是df2。【参考方案6】：
迟到了，这里有一个解决方案，它根据 OP 的规则使用 完全外连接和随后的行分组和聚合。
library(data.table)
threshold <- 30
# full outer join
m <- merge(setDT(df1)[, o := 1L], setDT(df2)[, o := 2L],
by = c("ID", "Days"), all = TRUE)
# reorder rows
setorder(m, ID, Days)
# create grouping variable
m[, g := rleid(ID,
cumsum(c(TRUE, diff(Days) > threshold)),
!is.na(o.x) & !is.na(o.y),
cumsum(c(TRUE, diff(fcoalesce(o.x, o.y)) == 0L))
)][, g := rleid(g, (rowid(g) - 1L) %/% 2)][]
# collapse rows where required
m[, .(ID = last(ID), Days = last(Days),
Score.x = last(na.omit(Score.x)),
Score.y = last(na.omit(Score.y)))
, by = g][, g := NULL][]
对于 OP 的第一个测试用例，我们得到
ID Days Score.x Score.y 1: patient1 0 NA 1 2: patient1 25 2 10 3: patient1 248 3 3 4: patient1 353 4 4 5: patient2 100 5 5 6: patient2 150 NA 7 7: patient3 503 NA 6 8: patient3 538 6 NA
正如预期的那样。
用其他用例验证
使用 OP 的第二个测试用例
df1 <- data.table(ID = rep("patient1", 5L), Days = c(0, 5, 10, 15, 50), Score = 1:5)
df2 <- data.table(ID = rep("patient1", 5L), Days = c(0, 5, 12, 15, 50), Score = 1:5)
我们得到
ID Days Score.x Score.y 1: patient1 0 1 1 2: patient1 5 2 2 3: patient1 12 3 3 4: patient1 15 4 4 5: patient1 50 5 5
使用 OP 的第 3 个测试用例（用于讨论 chinsoon12's answer）
df1 <- data.table(ID = paste0("patient", c(rep(1, 5L), 2, 2)),
Days = c(0, 116, 225, 309, 351, 0, 49), Score = 1:7)
df2 <- data.table(ID = paste0("patient", c(rep(1, 5L), 2, 2, 2)),
Days = c(0, 86, 195, 279, 315, 0, 91, 117), Score = 11:18)
我们得到
ID Days Score.x Score.y 1: patient1 0 1 11 2: patient1 116 2 12 3: patient1 225 3 13 4: patient1 309 4 14 5: patient1 315 NA 15 6: patient1 351 5 NA 7: patient2 0 6 16 8: patient2 49 7 NA 9: patient2 91 NA 17 10: patient2 117 NA 18
正如 OP 所期望的那样（特别是第 5 行）
最后，我自己的测试用例在233和248之间有5个“重叠天”来验证这个用例是否会被处理
df1 <- data.table(ID = paste0("patient", c(rep(1, 6L), 2, 3)),
Days = c(0,1,25,235,237,353,100,538),
Score = c(NA, 2:8))
df2 <- data.table(ID = paste0("patient", c(rep(1, 6L), 2, 2, 3)),
Days = c(0, 25, 233, 234, 248, 353, 100, 150, 503),
Score = 11:19)
我们得到
ID Days Score.x Score.y 1: patient1 0 NA 11 # exact match 2: patient1 1 2 NA # overlapping, not collapsed 3: patient1 25 3 12 # exact match 4: patient1 233 NA 13 # overlapping, not collapsed 5: patient1 235 4 14 # overlapping, collapsed 6: patient1 248 5 15 # overlapping, collapsed 7: patient1 353 6 16 # exact match 8: patient2 100 7 17 # exact match 9: patient2 150 NA 18 # not overlapping 10: patient3 503 NA 19 # not overlapping 11: patient3 538 8 NA # not overlapping
说明
完整的外部联接merge(..., all = TRUE) 查找相同 ID 和日期的完全匹配，但包括两个数据集中没有匹配的所有其他行。
在加入之前，每个数据集都会获得一个额外的列o，以指示每个Score 的来源。
结果是有序的，因为后续操作依赖于正确的行顺序。
所以，有了我自己的测试用例，我们得到了
m <- merge(setDT(df1)[, o := 1L], setDT(df2)[, o := 2L],
by = c("ID", "Days"), all = TRUE)
setorder(m, ID, Days)[]
ID Days Score.x o.x Score.y o.y 1: patient1 0 NA 1 11 2 2: patient1 1 2 1 NA NA 3: patient1 25 3 1 12 2 4: patient1 233 NA NA 13 2 5: patient1 234 NA NA 14 2 6: patient1 235 4 1 NA NA 7: patient1 237 5 1 NA NA 8: patient1 248 NA NA 15 2 9: patient1 353 6 1 16 2 10: patient2 100 7 1 17 2 11: patient2 150 NA NA 18 2 12: patient3 503 NA NA 19 2 13: patient3 538 8 1 NA NA
现在，使用rleid() 创建一个分组变量：
m[, g := rleid(ID,
cumsum(c(TRUE, diff(Days) > threshold)),
!is.na(o.x) & !is.na(o.y),
cumsum(c(TRUE, diff(fcoalesce(o.x, o.y)) == 0L))
)][, g := rleid(g, (rowid(g) - 1L) %/% 2)][]
当满足以下条件之一时，组计数器提前：
ID 更改
在ID 内，连续的Days 之间的间隔超过30 天（因此ID 内间隔为30 天或更短的行属于一个组或“重叠”）
当一行是直接匹配时，
当连续的行具有相同的原点时，从而识别出交替原点的行的条纹，例如，1, 2, 1, 2, ... 或 2, 1, 2, 1, ...
最后，在上述条纹中，计算交替来源的行对，例如，df1 中的一行，df2 中的一行，df2 中的一行，df1 中的一行.
OP 没有明确说明最后一个条件，但这是我对
的解释每个分数/天数/患者组合只能使用一次。如果合并满足所有条件但仍有可能进行双重合并， 应该使用第一个。
它确保最多折叠两行，每行来自不同的数据集。
分组后我们得到
ID Days Score.x o.x Score.y o.y g 1: patient1 0 NA 1 11 2 1 2: patient1 1 2 1 NA NA 2 3: patient1 25 3 1 12 2 3 4: patient1 233 NA NA 13 2 4 5: patient1 234 NA NA 14 2 5 6: patient1 235 4 1 NA NA 5 7: patient1 237 5 1 NA NA 6 8: patient1 248 NA NA 15 2 6 9: patient1 353 6 1 16 2 7 10: patient2 100 7 1 17 2 8 11: patient2 150 NA NA 18 2 9 12: patient3 503 NA NA 19 2 10 13: patient3 538 8 1 NA NA 11
大多数组仅包含一行，少数包含 2 行，在最后一步中折叠（按组聚合，返回所需列并删除分组变量 g）。
改进的代码
按组聚合要求对于每个组，每列只返回一个值（长度为 1 的向量）。 （否则，组结果将由多行组成。）为简单起见，上述实现在所有 4 列上都使用了last()。
last(Days) 等价于max(Days)，因为数据集是有序的。
但是，如果我理解正确，OP 更愿意从 df2 返回 Days 值（尽管 OP 已经提到 max(Days) 也是可以接受的）。
为了从df2返回Days值，需要修改聚合步骤：如果组大小.N大于1，我们从源自@987654358的行中选择Days值@，即o.y == 2。
# collapse rows where required
m[, .(ID = last(ID),
Days = last(if (.N > 1) Days[which(o.y == 2)] else Days),
Score.x = last(na.omit(Score.x)),
Score.y = last(na.omit(Score.y)))
, by = g][, g := NULL][]
这将返回
ID Days Score.x Score.y 1: patient1 0 NA 11 2: patient1 1 2 NA 3: patient1 25 3 12 4: patient1 233 NA 13 5: patient1 234 4 14 6: patient1 248 5 15 7: patient1 353 6 16 8: patient2 100 7 17 9: patient2 150 NA 18 10: patient3 503 NA 19 11: patient3 538 8 NA
现在折叠的第 5 行中的 Days 值 234 已从 df2 中选取。
对于Score 列，last() 的使用根本不重要，因为在一组 2 行中应该只有一个非 NA 值。所以，na.omit() 应该只返回一个值，last() 可能只是为了保持一致性。
【讨论】：
感谢您提供非常彻底和准确的回答。我将通过我的数据运行它，然后我会回复你。我注意到 gki 的答案在您的最新示例中出现了 1 行错误，因此这可能是一个更好的解决方案。不幸的是，赏金已经发放。 是的，我担心会发生这种情况，因为复选标记没有从第一个答案中撤回。以上是关于R基于具有添加条件的特定列合并两个数据集的主要内容，如果未能解决你的问题，请参考以下文章