R объединить два набора данных на основе указанных c столбцов с добавленным условием - PullRequest
Новая
       86

R объединить два набора данных на основе указанных c столбцов с добавленным условием

15 голосов
/ 28 мая 2020

Ответы Уве и ГКи верны. Gki получил награду, потому что Уве опоздал на это, но решение Уве работает примерно в 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 показывает идентификатор пациента, столбец Days показывает момент измерения (дни с момента включения пациента), а столбец Score показывает измеренный балл. Оба набора данных показывают одни и те же данные, но в разные моменты времени (df1 составлял 2 года a go, 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 <30) и приняли значение <code>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

EDIT FOR 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 неверны. Значение Score в df1 используется дважды (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")

Ответы [ 6 ]

5 голосов
/ 09 июня 2020
Решение

A 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 .. Первый тестовый пример от Бориса Руве, 1..2 тестовый пример от Бориса Руве, 2 .. 3-й тестовый пример от Boris Ruwe, 3..Test case from Uwe, 4..Test case from Boris Ruwe from R Rolling join two data.tables with error margin on join , 5..Test case from 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])

In в случае, если разницу в днях итого нужно минимизировать, позволяя не брать ближайший, возможный путь будет: 

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])),]
5 голосов
/ 05 июня 2020

Звучит как упражнение по очистке данных реалистичного c, но беспорядочного набора данных, с которым, к сожалению, большинство из нас уже сталкивались раньше. Вот еще один вариант 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

data ( Я добавил больше данных из другого связанного сообщения, а также упростил данные для облегчения просмотра): 

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]

Объяснение:

  1. выполнить 2 перекрывающихся соединения с использованием каждой таблицы в качестве левой таблицы по очереди.

  2. Объедините 2 результата, полученные до установки дней NA в правой таблице, с результатами из левой таблицы.

  3. Группа по пациенту и совпадающим датам. Если есть одинаковые даты, ведите записи. В противном случае используйте максимальную дату.

  4. Каждую оценку следует использовать только один раз, поэтому удалите дубликаты.

Сообщите мне, если вы обнаружите случаи где такой подход не дает правильных результатов.

4 голосов
/ 11 июня 2020

Опоздание на вечеринку, вот решение, которое использует полное внешнее соединение с последующей группировкой и агрегацией строк в соответствии с правилами 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

, как и ожидалось.

Проверка с другими вариантами использования

С 2-м тестовым примером 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 (который использовался для обсуждения ответа 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)

мы получаем 

          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)

Наконец, в моем собственном тестовом примере 5 "перекрывающихся дней "между 233 и 248, чтобы убедиться, что этот случай будет обработан 

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) находит точные совпадения с тем же идентификатором и днем, но включает все остальные строки из обоих наборов данных без совпадений.

Перед присоединением к каждому набору данных добавляется столбец 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 1075 разрывы более 30 дней. * (таким образом, строки с промежутком в 30 дней или меньше в пределах идентификатора принадлежат одной группе или "перекрываются")
  • , если строка является прямым совпадением,
  • , когда последовательные строки имеют одно и то же происхождение, тем самым идентифицируя полосы строк с переменным происхождением, например, 1, 2, 1, 2, ... или 2, 1, 2, 1, ...
  • , и, наконец, внутри указанных полос подсчитывает пары строк с переменным происхождением, например, одну строку из df1, за которым следует строка из df2 или одна строка из df2, за которой следует строка из df1.

Последнее условие не было явно указано ОП, но является моей интерпретацией

Каждая комбинация баллов / дней / пациентов может быть только использоваться один раз. Если слияние удовлетворяет всем условиям, но по-прежнему возможно двойное слияние, следует использовать первое.

Это гарантирует, что не более двух строк, каждая из разных наборов данных сворачиваются.

После группировки мы получаем 

          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) возвращается для каждого столбца. (В противном случае результат группы будет состоять из нескольких строк.) В приведенной выше реализации для простоты используется 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][]

Это вернет 

          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

Теперь Days значение 234 в свернутой строке 5 было выбрано из df2.

Для столбцов Score использование last() не имеет никакого значения, потому что в группе из 2 строк должно быть только одно значение, отличное от NA. Итак, na.omit() должен возвращать только одно значение, а last(), вероятно, просто для согласованности.

3 голосов
/ 05 июня 2020

Вот возможное 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 голосов
/ 28 мая 2020

Этот код позволяет указать порог, а затем объединить оценки из 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 голосов
/ 09 июня 2020

Следующий код работает с вашими образцами данных. Исходя из ваших условий, он должен работать на ваших полных данных. Для других исключений вы можете настроить 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Похожие темы

...