R根据特定列合并两个数据集并添加条件

Question

R根据特定列合并两个数据集并添加条件

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

Run Code Online (Sandbox Code Playgroud)

列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

Run Code Online (Sandbox Code Playgroud)

此处，第 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

Run Code Online (Sandbox Code Playgroud)

此输出显示先前输出的第 3 行和第 4 行已合并（因为 248-235 < 30）并采用Days了第二个 df (248) 的值。

要记住的三个主要条件是：

同一 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

Run Code Online (Sandbox Code Playgroud)

编辑 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

Run Code Online (Sandbox Code Playgroud)

我将您的解决方案包装在一个函数中，如下所示：

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)
}

Run Code Online (Sandbox Code Playgroud)

结果是：

> 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

Run Code Online (Sandbox Code Playgroud)

如您所见，第 4 行和第 5 行是错误的。Scoredf1 中的值使用了两次 (4)。这些行周围的正确输出应如下所示，因为每个分数（在本例中为 X 或 Y）只能使用一次：

          ID Days  X  Y
 4: patient1  309  4 14
 5: patient1  315 NA 15
 6: patient1  351  5 NA

Run Code Online (Sandbox Code Playgroud)

下面的数据帧代码。

> 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")

Run Code Online (Sandbox Code Playgroud)

Answer 1

chi*_*n12 5

听起来像是对现实但杂乱的数据集进行的数据清理练习，不幸的是，我们大多数人以前都有过这种经历。这是另一种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][]

Run Code Online (Sandbox Code Playgroud)

以下数据集的输出：

   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

Run Code Online (Sandbox Code Playgroud)

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

Run Code Online (Sandbox Code Playgroud)

数据（我从另一个链接的帖子中添加了更多数据，并简化了数据以便于查看）：

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]

Run Code Online (Sandbox Code Playgroud)

解释：

依次使用每个表作为左表执行 2 个重叠连接。
将右表中设置 NA 天数之前的 2 个结果与左表中的结果相结合。
按患者和重叠日期分组。如果存在相同的日期，则保留记录。否则使用最大日期。
每个 Score 只能使用一次，因此删除重复项。

如果您发现这种方法没有给出正确结果的情况，请告诉我。

Answer 2

GKi*_*GKi 5

一个基本解决方案，lapply用于查找天数差异低于阈值的位置，并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])),]

Run Code Online (Sandbox Code Playgroud)

数据：

0..来自 Boris Ruwe 的第一个测试用例，来自 Boris Ruwe 的 1..2nd 测试用例，来自 Boris Ruwe 的 2..3nd 测试用例，3..来自 Uwe 的测试用例，4..来自R 滚动连接的Boris Ruwe 的测试用例两个 data.tables 在 join 上有误差，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

Run Code Online (Sandbox Code Playgroud)

结果：

#           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

Run Code Online (Sandbox Code Playgroud)

格式化结果：

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

Run Code Online (Sandbox Code Playgroud)

获得的替代方法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])

Run Code Online (Sandbox Code Playgroud)

如果应尽量减少总天数差异，允许不取最近的，可能的方法是：

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])),]

Run Code Online (Sandbox Code Playgroud)

Answer 3

Uwe*_*Uwe 4

迟到了，这里有一个解决方案，它使用完整的外部连接根据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][]
Run Code Online (Sandbox Code Playgroud)
对于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
Run Code Online (Sandbox Code Playgroud)

正如预期的那样。

与其他用例验证

与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)
Run Code Online (Sandbox Code Playgroud)
我们得到

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
Run Code Online (Sandbox Code Playgroud)

使用OP的第三个测试用例（用于讨论chinsoon12的答案）

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)
Run Code Online (Sandbox Code Playgroud)
我们得到

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
Run Code Online (Sandbox Code Playgroud)

正如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)
Run Code Online (Sandbox Code Playgroud)
我们得到

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
Run Code Online (Sandbox Code Playgroud)

解释

完整外连接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)[]
Run Code Online (Sandbox Code Playgroud)

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
Run Code Online (Sandbox Code Playgroud)

现在，使用以下命令创建分组变量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)][]
Run Code Online (Sandbox Code Playgroud)
当满足以下条件之一时，组计数器将提前：

这ID

连续的时间间隔ID超过 30 天时Days（因此 ID 内间隔为 30 天或更短的行属于一组或“重叠”）

当一行是直接匹配时，

当连续的行具有相同的起源时，从而识别交替起源的行的条纹，例如，1, 2, 1, 2, ...或2, 1, 2, 1, ...

最后，在上述条纹内，对交替起源的行对进行计数，例如，一行 fromdf1后跟一行 fromdf2或一行 fromdf2后跟一行 from 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
Run Code Online (Sandbox Code Playgroud)

大多数组仅包含一行，少数包含 2 行，这些行在最后一步中折叠（按组聚合，返回所需的列并删除分组变量g）。

改进的代码

按组聚合要求每个组的每一列仅返回一个值（长度为 1 的向量）。last()（否则，组结果将由多行组成。）为了简单起见，上面的实现在所有 4 列上使用。

last(Days)相当于max(Days)因为数据集是有序的。

然而，如果我理解正确的话，OP更喜欢返回Days值df2（尽管OP已经提到过）max(Days)也是可以接受的）。

为了Days从df2聚合步骤返回值，需要修改：如果组大小.N大于 1，我们Days从源自的行中选取值df2，即其中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][]
Run Code Online (Sandbox Code Playgroud)
这将返回

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
Run Code Online (Sandbox Code Playgroud)

现在Days折叠行 5 中的值 234 已从中选取df2。

对于Score列，使用last()根本不重要，因为一组 2 行中应该只有一个非 NA 值。因此，na.omit()应该只返回一个值，并且last()可能只是为了保持一致性。

归档时间：	5 年，5 月前
查看次数：	1261 次
最近记录：	5 年，4 月前