Поисковые индексы в data.table R - PullRequest
Новая
       12

Поисковые индексы в data.table R

1 голос
/ 07 марта 2020

У меня есть data.table, proce, где каждая строка определяет «специальную процедуру». Теперь у меня есть еще одна таблица данных с процедурами пациента codes. Для каждого человека я хочу извлечь индексы «специальных процедур», которые соответствуют его / ее процедурам (если они есть). Вот пример: 

library(data.table)
proce <- data.table(v1 = c('o09513','o721','o701','z370'), v2 = c('0w8nxzz','10d07z6','0tqd7zz','0uqg0zz'),
                         v3 = c('3e030vj','3e033vj',NA,NA))

codes <- data.table(a1 =  c(list(c('o721','10d07z6','3e033vj')),
                            list(c('z370','0uqg0zz',"0tqd7zz","o701")),
                            list(c('o09513','o721','o701','z370','0uqg8zz'))))

> proce
       v1      v2      v3
1: o09513 0w8nxzz 3e030vj
2:   o721 10d07z6 3e033vj
3:   o701 0tqd7zz    <NA>
4:   z370 0uqg0zz    <NA>

> codes
                              a1
1:          o721,10d07z6,3e033vj
2:     z370,0uqg0zz,0tqd7zz,o701
3: o09513,o721,o701,z370,0uqg8zz

Реализация здесь, но поскольку в обеих таблицах сотни тысяч строк, она медленная. 


index_procedures <- list()     
for(i in 1:nrow(codes)){ # i <- 2
  a2 <- unlist(codes[i,a1])
  index_procedures[[i]] <- which(apply(proce[,.(v1,v2,v3)], 1,function(x) all(x[!is.na(x)] %in% a2)))
}
index_procedures
> index_procedures
[[1]]
[1] 2

[[2]]
[1] 3 4

[[3]]
integer(0)

Ответы [ 2 ]

1 голос
/ 08 марта 2020

Если я правильно понимаю,

  • codes содержит шаги процедуры, которые были применены к пациенту. Одна строка в codes относится к одному пациенту.
  • proce содержит этапы процедуры, которые составляют специальную процедуру .

ОП хочет определить, какие специальные процедуры были применены к каждому пациенту (если есть). Таким образом, специальная процедура считается примененной к пациенту только в том случае, если все его этапов процедуры применены.

Для решения этой проблемы я предлагаю изменить все данные в аккуратный формат , т. е. сначала в длинном формате.

Затем мы можем присоединиться к этапам процедуры, отфильтровать для завершить специальные процедуры и объединить, чтобы получить одно на пациента: 

lc <- codes[, cid := .I][, .(step = unlist(a1)), by = cid]
lp <- melt(proce[, pid := .I], "pid", na.rm = TRUE, value.name = "step")[
  , n_steps := .N, by = pid][]
lp[lc, on = .(step)][
  , .N == first(n_steps), by = .(cid, pid)][
    (V1), .(pid = toString(sort(pid))), by = cid]

   cid  pid
1:   1    2
2:   2 3, 4

Обратите внимание, что pid показаны в сжатой форме только для демонстрации; также доступны другие форматы вывода в зависимости от последующих этапов обработки.

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

lp[lc, on = .(step)][, .N == first(n_steps), by = .(cid, pid)][
  V1 | is.na(V1), .(pid = toString(sort(pid))), by = cid]

   cid  pid
1:   1    2
2:   2 3, 4
3:   3

Код комментария 

# reshape data to long format, thereby adding a row number to identify patients
lc <- codes[, cid := .I][, .(step = unlist(a1)), by = cid]
# reshape data to long format, thereby adding a row number to identify special procdures
lp <- melt(proce[, pid := .I], "pid", na.rm = TRUE, value.name = "step")[
  # count the number of procedure steps which constitute a special procedure
  , n_steps := .N, by = pid][]
# join on procedure steps
lp[lc, on = .(step)][
  # group  by patient and special procedure and test for completeness of steps 
  , .N == first(n_steps), by = .(cid, pid)][
    # filter for complete special procedures and aggregate to get one row per patient
    (V1), .(pid = toString(sort(pid))), by = cid]

После изменения формы lc равен 

    cid    step
 1:   1    o721
 2:   1 10d07z6
 3:   1 3e033vj
 4:   2    z370
 5:   2 0uqg0zz
 6:   2 0tqd7zz
 7:   2    o701
 8:   3  o09513
 9:   3    o721
10:   3    o701
11:   3    z370
12:   3 0uqg8zz

и lp равен 

    pid variable    step n_steps
 1:   1       v1  o09513       3
 2:   2       v1    o721       3
 3:   3       v1    o701       2
 4:   4       v1    z370       2
 5:   1       v2 0w8nxzz       3
 6:   2       v2 10d07z6       3
 7:   3       v2 0tqd7zz       2
 8:   4       v2 0uqg0zz       2
 9:   1       v3 3e030vj       3
10:   2       v3 3e033vj       3
0 голосов
/ 08 марта 2020

Я не уверен в производительности, но следующий код может быть альтернативой: 

pl <- split(as.matrix(proce), seq_len(nrow(proce)))
pl <- lapply(pl, na.omit)

codes[, indexes := lapply(a1, function(x) which(unlist(lapply(pl, function(p) all(p %in% x)))) )]
...