R：在按日期匹配行之后，将第一个dfrm中多个列中的NA值替换为第二个dfrm中的值

Question

这是我努力重建昨天出现的一个问题，我早上大部分时间都在努力解决这个问题但却无法再找到问题。 2个数据集，df1和较小的df2，提供了相同的列名称，请求仅替换date列匹配的行中的NA值。 我想合并可以做到这一点，并且可能不那么繁重，但我正在寻找match() -ing和索引策略并最终找到一个：

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

实际提供了什么：

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

is.na函数可以从is.na参数创建逻辑的“模板”。 我的目标是创建这样一个模板，然后只选择两个date列之间match结果的行。 使用which与arr.ind = TRUE得到，可用于作为单个参数的两列的矩阵要么[<-或[ ：

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

下一个任务是转换第一列（名为“row”），以便用正确的行代替“目标”数据帧：

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

那就是：

> 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

当我把订单拖到日期时，我确实让问题变得更加困难。 我认为这种逻辑也很难解决这个问题。

Answer 2

以下解决方案根据date列预先计算（1）从df2到df1的行映射，以及（2）两个data.frame之间的公共数据列名称。 然后它遍历公共列，并且每个列测试df1列中的哪些单元都映射到df2并且具有NA值，然后从df2可用的任何值分配这些单元。

好处：

• 不需要完全相应的柱组; 将按列名匹配它们。
• 处理最少量的数据，仅通过迭代公共列，仅对测试映射到df2的df1单元进行NA测试，并仅分配NA单元。
• 保护输入列数据类型。 IOW，如果df1具有异构列类型，则此操作不会破坏这些类型。

---

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

---

标杆

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