如何在不使用兩個for-loops的情況下填充我的data.table？

Question

我無法在任何地方找到答案，我可能沒有找到正確的搜索條件或無法將問題轉移到我的。

所以我希望這裏有人能夠幫助我。

我有以下形式（我試圖保持它短，但包括所有可能需要）一個data.table DT1：

ID session 
101 1 
101 1 
101 2 
101 4 
102 2 
102 4 
102 5 
103 1 
103 4 
201 1 
201 4 
201 5 
202 1 
202 2 
203 1 
204 5 

代碼重現此：

dt1 <- data.table(ID=c(101, 101, 101, 101, 102, 102, 102, 103, 103, 201, 201, 201, 202, 202, 203, 204), session=c(1, 1, 2, 4, 2, 4, 5, 1, 4, 1, 4, 5, 1, 2, 1, 5)) 

我想要的第一步是在表單中創建一個data.table，其中當輸入data.frame中有一個條目時，每個會話都有一個1，如果沒有，則爲0。

ID 1 2 3 4 5 
101 1 1 0 1 0 
102 0 1 0 1 1 
103 1 0 0 1 0 
201 1 0 0 1 1 
202 1 1 0 0 0 
203 1 0 0 0 0 
204 0 0 0 0 1 

現在，我生成兩個列表，

IDs <- sort(unique(dt1$ID)) 
sessions <- unique(dt1$session) 

空data.table dt2與ncol=length(sessions)和nrow=length(IDs)，與會話作爲列名

dt2 <- data.table(matrix(ncol=length(sessions), nrow=length(IDs))) 
colnames(dt2) <- as.character(unique(dt1$session)) 

和列表每個ID都有會話。

sesID <- split(dt1$session, dt1$ID) 

然後，我用兩個for循環遍歷列表。

for (i in 1:nrow(dt2)) { 
for (j in 1:length(dt2)) { 
    if (sessions[j] %in% sesID[i]) { 
    set(dt2, i, j, 1)s 
    } 
    else { 
    set(dt2, i, j, 0) 
    } } } 

作爲第二步，我想要將所有的0更改爲1，如果會話位於具有1s的會話之間。

ID 1 2 3 4 5 
101 1 1 1 1 0 
102 0 1 1 1 1 
103 1 1 1 1 0 
201 1 0 0 1 1 
202 1 1 0 0 0 
203 1 0 0 0 0 
204 0 0 0 0 1 

我這樣做與另外兩個for循環。

for (i in 1:nrow(dt2)) { 
trues <- which(dt2[i,]==1) 
headTrues <- head(trues, 1) 
tailTrues <- tail(trues, 1) 
for (j in 1:length(dt2)){ 
    if (j > headTrues & j < tailTrues & headTrues <= tailTrues){ 
    set(dt2, i, j, 1) 
} } } 

由於這會生成一個data.table dt3，其中包含TRUE和FALSE，因此我將其替換。

(to.replace <- names(which(sapply(dt3, is.logical)))) 
for (var in to.replace) dt3[, var:= as.numeric(get(var)), with=FALSE] 

爲了將ID保留爲列，我在後面添加它們。

dt3$ID <- IDs 

如果我沒有大約12000個唯一ID並需要做幾千次運行，這樣可以。我非常肯定，在R中有更好的方法來做到這一點。我現在還沒有。

非常感謝您提前。

Answer 1

使用：

# create a reference data.table which includes also 'session 3' 
ref <- CJ(ID = dt1$ID, session = min(dt1$session):max(dt1$session), unique = TRUE) 
# join 'ref' with 'dt1' and create a new variable that has NA's 
# for values that don't exist in 'dt1$session' 
ref[dt1, on = c('ID','session'), ses2 := i.session] 

# summarise to create a dummy and reshape to wide format with the 'dcast'-function 
dcast(ref[, sum(!is.na(ses2)), .(ID,session)], 
     ID ~ session, value.var = 'V1') 

你：

ID 1 2 3 4 5 
1: 101 1 1 0 1 0 
2: 102 0 1 0 1 1 
3: 103 1 0 0 1 0 
4: 201 1 0 0 1 1 
5: 202 1 1 0 0 0 
6: 203 1 0 0 0 0 
7: 204 0 0 0 0 1 

的alternat （如@Frank在評論中提出的那樣）：

dt1[, session := factor(session, levels=1:5)] 
dcast(dt1, ID ~ session, fun = function(x) sign(length(x)), drop = FALSE) 

這會給你同樣的結果。

---

如果你想填補零的1之間的，你可以使用shift - 函數來檢查前面的和未來價值等於1：

dcast(ref[, sum(!is.na(ses2)), .(ID,session) 
      ][shift(V1,1,0,'lag')==1 & shift(V1,1,0,'lead')==1, V1 := 1L, ID], 
     ID ~ session, value.var = 'V1') 

那麼你將得到：

ID 1 2 3 4 5 
1: 101 1 1 1 1 0 
2: 102 0 1 1 1 1 
3: 103 1 0 0 1 1 
4: 201 1 0 0 1 1 
5: 202 1 1 0 0 0 
6: 203 1 0 0 0 0 
7: 204 0 0 0 0 1 

---

在回答您的意見，以取代所有零'S b切口白內障手術挽1的可以使用的rle和inverse.rle功能的組合：

dt2 <- unique(dt1)[, val := 1 
        ][CJ(ID = ID, session = min(session):max(session), unique = TRUE), on = c('ID','session') 
        ][is.na(val), val := 0 
         ][, val := {rl <- rle(val); 
            rl$values[rl$values==0 & shift(rl$values,fill=0)==1 & shift(rl$values,fill=0,type='lead')==1] <- 1; 
            inverse.rle(rl)}, 
         ID] 

dcast(dt2, ID ~ session, value.var = 'val') 

這給：

ID 1 2 3 4 5 
1: 101 1 1 1 1 0 
2: 102 0 1 1 1 1 
3: 103 1 1 1 1 0 
4: 201 1 1 1 1 1 
5: 202 1 1 0 0 0 
6: 203 1 0 0 0 0 
7: 204 0 0 0 0 1 

或者（@弗蘭克的想法）：

ref[, v := 0L] 
ref[dt1[, .(first(session), last(session)), by=ID], on=.(ID, session >= V1, session <= V2), 
    v := 1L ] 
dcast(ref, ID ~ session) 

---

當所有數據集中存在不同的會話編號，您還可以使用嵌套的dcast/melt -approach作爲交叉連接的一種替代方法（關於速度和內存效率，以前採用交叉連接的方法（CJ）是可取的）。

新例如數據集：

DT <- data.table(ID=c(101, 101, 101, 101, 102, 102, 102, 103, 103, 201, 201, 201, 202, 202, 203, 204), 
       session=c(1, 2, 3, 4, 2, 4, 5, 1, 4, 1, 4, 5, 1, 2, 1, 5)) 

代碼：

dcast(melt(dcast(DT[, val := 1], 
       ID ~ session, 
       value.var = 'val', 
       fill = 0), 
      id = 'ID')[, value := {rl <- rle(value); 
      rl[[2]][rl[[2]]==0 & shift(rl[[2]],1,0)==1 & shift(rl[[2]],1,0,'lead')==1] <- 1; 
      inverse.rle(rl)}, 
      ID], 
     ID ~ variable, value.var = 'value') 

這給：

ID 1 2 3 4 5 
1: 101 1 1 1 1 0 
2: 102 0 1 1 1 1 
3: 103 1 1 1 1 0 
4: 201 1 1 1 1 1 
5: 202 1 1 0 0 0 
6: 203 1 0 0 0 0 
7: 204 0 0 0 0 1 

Answer 2

你可以用這種方式完成第一步......你正在尋找什麼？

library(dplyr) 
df_dt1 %>% group_by (ID) %>% summarize (S1 = as.integer(sum(session == 1)>0), 
            S2 = as.integer(sum(session ==2)>0), 
            S3 = as.integer(sum(session ==3)>0), 
            S4 = as.integer(sum(session ==4)>0), 
            S5 = as.integer(sum(session ==5)>0)) 

你

 ID S1 S2 S3 S4 S5 
    <dbl> <int> <int> <int> <int> <int> 
1 101  1  1  0  1  0 
2 102  0  1  0  1  1 
3 103  1  0  0  1  0 
4 201  1  0  0  1  1 
5 202  1  1  0  0  0 
6 203  1  0  0  0  0 
7 204  0  0  0  0  1 

Answer 3

的一種方法是使用reshape。

首先創建value等於1列：

dt1[, value := 1] 

現在reshape它wide格式：

dt1.1 <- reshape(dt1, direction = "wide", idvar = "ID", timevar = "session") 

你會得到這樣的：

ID value.1 value.2 value.4 value.5 
1: 101  1  1  1  NA 
2: 102  NA  1  1  1 
3: 103  1  NA  1  NA 
4: 201  1  NA  1  1 
5: 202  1  1  NA  NA 
6: 203  1  NA  NA  NA 
7: 204  NA  NA  NA  1 

替換NA與0：

dt1.1[is.na(dt1.1)] <- 0 

    ID value.1 value.2 value.4 value.5 
1: 101  1  1  1  0 
2: 102  0  1  1  1 
3: 103  1  0  1  0 
4: 201  1  0  1  1 
5: 202  1  1  0  0 
6: 203  1  0  0  0 
7: 204  0  0  0  1 

或者與dcast：

dcast(ID ~ session, data = dt1, fun.aggregate = function(x) as.numeric(length(x) > 0)) 

    ID 1 2 4 5 
1 101 1 1 1 0 
2 102 0 1 1 1 
3 103 1 0 1 0 
4 201 1 0 1 1 
5 202 1 1 0 0 
6 203 1 0 0 0 
7 204 0 0 0 1