2017-04-06 38 views
6

這裏是類似於一個較大的數據集的示例數據幀:計數序列以包括NA值

Day <- c(1, 2, NA, 3, 4, NA, NA, NA, NA, NA, 1, 2, 3, NA, NA, NA, NA, 1, 2, NA, NA, 3, 4, 5) 
y <- rpois(length(Day), 2) 
z <- seq(1:length(Day)) + 500 
df <- data.frame(z, Day, y) 

如果有在日第4個或更多缺失值(NAS)的序列,即序列代表了研究中隊列之間的差距。如果序列中少於4個NA,那麼缺失值仍被認爲是隊列的一部分(例如,第3行是第1隊列的一部分,但第8行不是)。在樣本數據框中,有3個隊列(隊列1:行1-5,隊列2:行11-13,隊列3:行18-24)。我想添加列出隊列號的列和列出隊列研究日的另一列。這裏是我使用的代碼:

require(dplyr) 
CheckNA  <- rle(is.na(df$Day)) 
CheckNA$values <- CheckNA$lengths >= 4 & CheckNA$values == 1 
ListNA   <- rep(CheckNA$values, CheckNA$lengths) 
df$Co   <- rep(c(1, NA, 2, NA, 3), rle(ListNA)$lengths) %>% as.factor() 

df <- df %>% 
    group_by (Co) %>% 
    mutate(CoDay = seq(Co)) %>% 
    as.data.frame() 

df$CoDay <- ifelse(is.na(df$Co), NA, df$CoDay) 

是否有更有效的方法來完成此任務?我特別尋找代碼以避免列出隊列編號,因爲我的實際數據集將有超過10個隊列。我目前只列出了應該重複的序列:c(1,NA,2,NA,3)。

謝謝!

+0

這已經交叉張貼在代碼審查:http://codereview.stackexchange.com/questions/160059/r-code-to-count-a-sequence-of-cohort-studies –

+0

我有從Code Review中刪除它。 –

回答

5

我在這裏做一個改變

CheckNA  <- rle(is.na(df$Day)) 
CheckNA$values <- CheckNA$lengths >= 4 & CheckNA$values == 1 
CheckNA$values <- ifelse(!CheckNA$values, cumsum(CheckNA$values)+1, NA) 
df$Co <- inverse.rle(CheckNA) 

我保留了前兩行一樣,然後我用cumsum()以各個擊破分配新的ID。這意味着您不必對任何值進行硬編碼。使用新的值,您可以使用inverse.rle,這與您使用rep()將新ID擴展到每個行的方式相同。

如果你把它轉換成一個功能,可以清理dplyr

id_NA_break <- function(x) { 
    CheckNA  <- rle(is.na(x)) 
    CheckNA$values <- CheckNA$lengths >= 4 & CheckNA$values == 1 
    CheckNA$values <- ifelse(!CheckNA$values, cumsum(CheckNA$values)+1, NA) 
    inverse.rle(CheckNA) 
} 

df <- data.frame(z, Day, y) 
df %>% 
    mutate(Co=id_NA_break(Day)) %>% 
    group_by(Co) %>% 
    mutate(CoDay = ifelse(is.na(Co), NA, seq(Co))) 
3

這裏有一個data.table解決方案。我不確定這兩個函數是如何比較的。我們必須對它們進行基準測試。通常data.table更快,但我最終在這裏使用了很多步驟。

library(data.table) 
Day <- c(1, 2, NA, 3, 4, NA, NA, NA, NA, NA, 1, 2, 3, NA, NA, NA, NA, 1, 2, NA, NA, 3, 4, 5) 
y <- rpois(length(Day), 2) 
z <- seq(1:length(Day)) + 500 
df <- data.frame(z, Day, y) 

setDT(df) 

df[ , "isNA" := ifelse(is.na(Day), 1, 0)] 
df[ , "numNA" := rep(rle(isNA)$length*rle(isNA)$value, rle(isNA)$length)] 
df[ , "Gap" := ifelse(numNA < 4, 0, 1)] 
df[ , "Cohort" := cumsum(Gap)] 

df[Gap == 1, "Cohort" := NA] 
df[Gap == 0, "Cohort" := as.double(rleid(Cohort))] 

> df 
     z Day y isNA numNA Gap Cohort 
1: 501 1 1 0  0 0  1 
2: 502 2 2 0  0 0  1 
3: 503 NA 2 1  1 0  1 
4: 504 3 1 0  0 0  1 
5: 505 4 2 0  0 0  1 
6: 506 NA 2 1  5 1  NA 
7: 507 NA 1 1  5 1  NA 
8: 508 NA 0 1  5 1  NA 
9: 509 NA 4 1  5 1  NA 
10: 510 NA 2 1  5 1  NA 
11: 511 1 3 0  0 0  2 
12: 512 2 3 0  0 0  2 
13: 513 3 2 0  0 0  2 
14: 514 NA 3 1  4 1  NA 
15: 515 NA 1 1  4 1  NA 
16: 516 NA 3 1  4 1  NA 
17: 517 NA 2 1  4 1  NA 
18: 518 1 4 0  0 0  3 
19: 519 2 4 0  0 0  3 
20: 520 NA 1 1  2 0  3 
21: 521 NA 1 1  2 0  3 
22: 522 3 3 0  0 0  3 
23: 523 4 0 0  0 0  3 
24: 524 5 3 0  0 0  3 
     z Day y isNA numNA Gap Cohort 

清理多餘的列

df[ , c("isNA", "numNA", "Gap") := NULL] 

編輯 MrFlick的速度更快。我通過microbenchmark來運行它們。

> microbenchmark(data_table_way(df)) 
Unit: milliseconds 
       expr  min  lq  mean median  uq  max neval 
data_table_way(df) 2.515004 2.678493 2.879678 2.770054 2.923348 4.917869 100 

> microbenchmark(dplyr_way()) 
Unit: milliseconds 
     expr  min  lq  mean median  uq  max neval 
dplyr_way() 1.564279 1.703792 1.814998 1.765713 1.824615 2.773641 100