Đếm một chuỗi bao gồm NA đánh giá cao

Question

Đây là một khung dữ liệu mẫu tương tự như một bộ dữ liệu lớn hơn:

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) 

Nếu có một chuỗi 4 hoặc thiếu nhiều giá trị (NAS) trong cột ngày, mà trình tự đại diện cho một khoảng cách giữa các nhóm thuần tập trong nghiên cứu. Nếu có ít hơn 4 NA trong một chuỗi, thì giá trị còn thiếu vẫn được coi là một phần của nhóm thuần tập (ví dụ: hàng 3 là một phần của nhóm thuần tập 1, nhưng hàng 8 không phải là). Trong khung dữ liệu mẫu, có 3 nhóm thuần tập (Nhóm 1: hàng 1-5, Nhóm 2: hàng 11-13 và Nhóm thuần tập 3: hàng 18-24). Tôi muốn thêm cột liệt kê số nhóm và một cột khác liệt kê ngày nghiên cứu thuần tập. Đây là mã tôi đã sử dụng:

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) 

Có cách nào hiệu quả hơn để thực hiện tác vụ này không? Tôi đặc biệt tìm kiếm mã để tránh phải liệt kê số nhóm, vì tập dữ liệu thực tế của tôi sẽ có hơn 10 nhóm thuần tập. Tôi hiện đang liệt kê các chuỗi cần lặp lại: c (1, NA, 2, NA, 3).

Cảm ơn bạn!

Answer 1

Tôi muốn làm cho một sự thay đổi ở đây

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) 

Tôi giữ hai dòng đầu tiên như nhau, sau đó tôi sử dụng cumsum() để gán ID mới tại từng nghỉ ngơi. Điều này có nghĩa là bạn sẽ không phải mã hóa cứng bất kỳ giá trị nào. Với các giá trị mới, bạn có thể sử dụng inverse.rle nhiều trong cùng một cách bạn đã sử dụng rep() để mở rộng ID mới cho từng hàng.

Nếu bạn biến chúng thành một chức năng, bạn có thể dọn dẹp dplyr bit

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

Answer 2

Dưới đây là một giải pháp data.table. Tôi không chắc hai hàm sẽ so sánh như thế nào. Chúng tôi sẽ phải chuẩn bị chúng. Thông thường data.table nhanh hơn, nhưng tôi đã sử dụng rất nhiều bước ở đây.

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 

để dọn dẹp các cột thêm

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

EDIT MrFlick là nhanh hơn. Tôi chạy cả hai thông qua 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