eine Sequenz umfasst NA-Wert

Question

Hier ist ein Beispiel Datenrahmen, die eine größere Datenmenge entspricht:

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) 

Wenn es eine Folge von 4 oder mehr fehlenden Werten (NAs) in der Tag-Säule, daß Sequenz repräsentiert eine Lücke zwischen den Kohorten in der Studie. Wenn weniger als 4 NAs in einer Sequenz vorhanden sind, wird der fehlende Wert immer noch als Teil der Kohorte betrachtet (z. B. ist Zeile 3 Teil von Kohorte 1, aber Zeile 8 nicht). Im Beispieldatenrahmen gibt es 3 Kohorten (Kohorte 1: Reihen 1-5, Kohorte 2: Reihen 11-13 und Kohorte 3: Reihen 18-24). Ich möchte eine Spalte hinzufügen, in der die Kohortennummer und eine weitere Spalte mit dem Kohortenstudiestag aufgelistet sind. Hier ist der Code, den ich verwendet habe:

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) 

Gibt es eine effizientere Möglichkeit, diese Aufgabe zu erfüllen? Ich suche speziell nach Code, um die Kohortenummer nicht auflisten zu müssen, da mein aktueller Datensatz über 10 Kohorten enthält. Ich liste gerade die Reihenfolge auf, die wiederholt werden sollte: c (1, NA, 2, NA, 3).

Vielen Dank!

Answer 1

ich eine Änderung vornehmen würde hier

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) 

hielt ich die ersten beiden Zeilen gleich sind, dann habe ich cumsum() bei jeder Pause neue IDs zuweisen. Dies bedeutet, dass Sie keine Werte fest codieren müssen. Mit den neuen Werten können Sie inverse.rle viel auf die gleiche Weise verwenden, die Sie rep() verwendeten, um die neue ID in jeder der Zeilen zu erweitern.

Falls Sie in eine Funktion aktivieren, können Sie die dplyr Bits

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

Hier ist eine data.table Lösung aufzuräumen. Ich bin nicht sicher, wie die zwei Funktionen vergleichen würden. Wir müssten sie vergleichen. Normalerweise ist data.table schneller, aber ich habe hier viele Schritte gebraucht.

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 

zur Reinigung der zusätzlichen Spalten

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

EDIT MrFlick das ist schneller. Ich habe sie beide durch Microbenchmark laufen lassen.

> 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