R: Ersetzen Sie NA-Werte in mehreren Spalten in der ersten dfrm mit Werten aus der zweiten dfrm nach übereinstimmenden Zeilen nach Datum

Question

Dies ist meine Bemühung, eine Frage zu rekonstruieren, die gestern und die ich den größten Teil des Morgens zu lösen, aber nicht mehr finden konnte die Frage. 2 Datasets, df1 und ein kleineres df2, wurden mit den gleichen Spaltennamen mit der Anforderung versehen, nur die NA-Werte in den Zeilen zu ersetzen, in denen die Spalte date übereinstimmte. Ich nehme an, ein Merge es getan haben könnte und gut hätte weniger belastend gewesen, aber ich war ein match() -ing und Indexierungsstrategie suchen und fand schließlich ein:

df1 <- structure(list(date = c(20040101L, 20040115L, 20040131L, 20040205L, 
20040228L, 20040301L, 20040315L, 20040331L), X11A = c(100L, 200L, 
NA, NA, NA, 150L, NA, NA), X11A.1 = c(150L, NA, 165L, NA, NA, 
155L, NA, NA), X21B = c(NA, 200L, 180L, NA, NA, 170L, 180L, NA 
), X3CC = c(NA, NA, 190L, NA, NA, 150L, 190L, 175L), X3CC.1 = c(140L, 
NA, 190L, NA, NA, 160L, 200L, 180L)), .Names = c("date", "X11A", 
"X11A.1", "X21B", "X3CC", "X3CC.1"), class = "data.frame", row.names = c(NA, 
-8L)) 

df2 <- structure(list(date = c(20040228L, 20040131L, 20040331L), X11A = c(140L, 
170L, NA), X11A.1 = c(145L, NA, 145L), X21B = c(165L, NA, 160L 
), X3CC = c(150L, NA, NA), X3CC.1 = c(155L, NA, NA)), .Names = c("date", 
"X11A", "X11A.1", "X21B", "X3CC", "X3CC.1"), class = "data.frame", row.names = c(NA, 
-3L)) 

Was tatsächlich angeboten wurde:

df1:

date  11A 11A 21B 3CC 3CC 
20040101 100 150  NA  NA 140 
20040115 200  NA 200  NA  NA 
20040131  NA 165 180 190 190 
20040205  NA  NA  NA  NA  NA 
20040228  NA  NA  NA  NA  NA 
20040301 150 155 170 150 160 
20040315  NA  NA 180 190 200 
20040331  NA  NA  NA 175 180 

df2:

date  11A 11A 21B 3CC 3CC 
20040228 140 145 165 150 155 
20040131 170  NA  NA  NA  NA 
20040331  NA 145 160  NA  NA 

Answer 1

Der is.na Funktion kann eine "Vorlage" von logischen Daten aus einem Datenrahmenargument erstellen. Mein Ziel war es, eine solche Vorlage zu erstellen und dann nur die Zeilen mit einem match Ergebnis zwischen den beiden date Spalten auszuwählen. Verwendung which mit arr.ind = TRUE eine zweispaltige Matrix geben, die als ein einziges Argument verwendet werden können, um entweder [<- oder [:

valpos <- which(is.na(df1)[match(df2$date, df1$date), ], arr.ind=TRUE) 

Die nächste Aufgabe die erste Spalte zu konvertieren ist so („Reihe“ genannt) dass die richtige Zeile für das „Ziel“ Datenrahmen ersetzt wird:

targpos <- cbind(match(df2$date, df1$date)[ valpos[,'row'] ] , 
        valpos[,'col']) 

Dann ist es einfach:

> df1[targpos] <- df2[valpos] 
> df1 
     date X11A X11A.1 X21B X3CC X3CC.1 
1 20040101 100 150 NA NA 140 
2 20040115 200  NA 200 NA  NA 
3 20040131 170 165 180 190 190 
4 20040205 NA  NA NA NA  NA 
5 20040228 140 145 165 150 155 
6 20040301 150 155 170 150 160 
7 20040315 NA  NA 180 190 200 
8 20040331 NA 145 160 175 180 

ich habe das Problem, eine machen etwas schwieriger, wenn ich die Reihenfolge zu den Daten mische. Ich denke, diese Logik löst das auch schwer.

Answer 2

Die folgende Lösung berechnet im Voraus (1) die Zeilenzuordnung von df2 bis df1 gemäß der Spalte date und (2) die gemeinsamen Datenspaltennamen zwischen den beiden data.frames. Es iteriert dann über die gemeinsamen Spalten und testet für jede Zelle, welche Zellen innerhalb der df1-Spalte beide auf df2 abgebildet sind und einen Wert von NA haben, und weist diese Zellen dann dem Wert zu, der in df2 verfügbar ist.

Vorteile:

• nicht einwandfrei entsprechenden Spaltensätze erfordern; wird sie nach dem Spaltennamen abgleichen.
• Verarbeitet die minimale Datenmenge, indem nur über die gemeinsamen Spalten iteriert wird, wobei nur die df1 Zellen, die df2 zugeordnet sind, NA-getestet werden und nur die NA-Zellen zugewiesen werden.
• Schützt die Eingabespalten-Datentypen. IOW, wenn df1 heterogene Spaltentypen hatte, würden diese Typen durch diese Operation nicht beschädigt werden.

---

rms <- match(df2$date,df1$date); 
cms <- intersect(names(df1)[-1L],names(df2)[-1L]); 
for (cm in cms) { n <- is.na(df1[[cm]][rms]); df1[[cm]][rms][n] <- df2[[cm]][n]; }; 
df1; 
##  date X11A X11A.1 X21B X3CC X3CC.1 
## 1 20040101 100 150 NA NA 140 
## 2 20040115 200  NA 200 NA  NA 
## 3 20040131 170 165 180 190 190 
## 4 20040205 NA  NA NA NA  NA 
## 5 20040228 140 145 165 150 155 
## 6 20040301 150 155 170 150 160 
## 7 20040315 NA  NA 180 190 200 
## 8 20040331 NA 145 160 175 180 

---

Benchmarking

library(microbenchmark); 

`42` <- function(df1,df2) { valpos <- which(is.na(df1)[match(df2$date,df1$date),],arr.ind=TRUE); targpos <- cbind(match(df2$date,df1$date)[valpos[,'row']],valpos[,'col']); df1[targpos] <- df2[valpos]; df1; }; 
bgoldst <- function(df1,df2) { rms <- match(df2$date,df1$date); cms <- intersect(names(df1)[-1L],names(df2)[-1L]); for (cm in cms) { n <- is.na(df1[[cm]][rms]); df1[[cm]][rms][n] <- df2[[cm]][n]; }; df1; }; 

identical(`42`(df1,df2),bgoldst(df1,df2)); 
## [1] TRUE 
microbenchmark(`42`(df1,df2),bgoldst(df1,df2)); 
## Unit: microseconds 
##    expr  min  lq  mean median  uq  max neval 
##  `42`(df1, df2) 297.219 309.1935 340.1425 319.0295 333.9975 1236.771 100 
## bgoldst(df1, df2) 175.766 181.7530 192.9317 188.1670 198.2180 316.463 100 

---

set.seed(1L); 
NR1 <- 10000L; NC1 <- 300L; NR2 <- 1000L; NC2 <- 300L; probNA1 <- 0.5; probNA2 <- 0.1; 
df1 <- data.frame(date=as.integer(format(sort(sample(seq(as.Date('2004-01-01'),by=1L,len=NR1*5L),NR1)),'%Y%m%d'))); 
df1[paste0('X',seq_len(NC1))] <- matrix(sample(c(NA,100:200),NR1*NC1,T,c(probNA1,rep((1-probNA1)/101,101L))),NR1); 
df2 <- data.frame(date=sample(df1$date,NR2)); 
df2[paste0('X',seq_len(NC2))] <- matrix(sample(c(NA,100:200),NR2*NC2,T,c(probNA2,rep((1-probNA2)/101,101L))),NR2); 

identical(`42`(df1,df2),bgoldst(df1,df2)); 
## [1] TRUE 
microbenchmark(`42`(df1,df2),bgoldst(df1,df2)); 
## Unit: milliseconds 
##    expr  min  lq  mean median  uq  max neval 
##  `42`(df1, df2) 149.61503 194.66606 216.16916 231.25129 233.68079 277.24701 100 
## bgoldst(df1, df2) 29.17145 31.32318 37.85904 32.15154 33.24013 75.47765 100