एक दृश्य गणना शामिल करने के लिए लागू नहीं महत्व देता

Question

यहां एक नमूना डेटा फ्रेम कि एक बड़ा डेटा सेट जैसा दिखता है:

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 से कम एनएएस हैं, तो गायब मान को अभी भी समूह का हिस्सा माना जाता है (उदाहरण के लिए, पंक्ति 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 से अधिक समूह होंगे। मैं वर्तमान में अनुक्रम को सूचीबद्ध करता हूं जिसे दोहराया जाना चाहिए: सी (1, एनए, 2, एनए, 3)।

धन्यवाद!

Answer 1

मैं एक परिवर्तन यहाँ

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() इस्तेमाल किया प्रत्येक ब्रेक में नया आईडी निर्दिष्ट करने। इसका मतलब है कि आपको किसी भी मूल्य को कड़ी-कोड नहीं करना पड़ेगा। नए मानों के साथ, आप प्रत्येक पंक्ति में नई आईडी को विस्तारित करने के लिए inverse.rle का उपयोग उसी तरीके से कर सकते हैं जैसे आपने rep() का उपयोग किया था।

यदि आप एक समारोह में है कि बारी है, आप 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))) 

Answer 2

यहाँ एक data.table समाधान है साफ कर सकते हैं। मुझे यकीन नहीं है कि दो कार्यों की तुलना कैसे की जाएगी। हमें उन्हें बेंचमार्क करना होगा। आम तौर पर डेटा.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