这比看起来要困难得多。我构建了一个一次处理一列的解决方案,采用所有时间列索引和当前列索引之间的绝对距离的pmin(),使用na.rm=T 参数剥离NA。然后可以使用索引矩阵将结果用于索引原始时间列,然后可以将其分配给目标 data.frame 中的当前列索引。
这种设计的一个优点是它在行上完全矢量化。换句话说,它不会一次迭代一行。这对于非常多行的输入可能是一个优势。另一方面,该解决方案确实涉及构建与所有时间列(timemat、nacols 和 off)平行的矩阵,这对于大型输入可能会很昂贵。它基本上是用内存来节省 CPU。
我添加了几行来测试 OP 的示例 data.frame 未涵盖的其他案例;特别是 (1) 一个全 NA 行,以及 (2) 在 NA 值的任一侧具有候选非 NA 值的行。
输入:
df <- data.frame(ID=c('01','02','03','04','05','06','07','08'),Time1=c(23L,21L,22L,NA,29L,NA,NA,1L),Time2=c(23L,21L,22L,NA,29L,NA,NA,NA),Time3=c(NA,21L,25L,NA,20L,15L,11L,NA),Time4=c(NA,NA,NA,NA,NA,22L,NA,2L),stringsAsFactors=F);
df;
## ID Time1 Time2 Time3 Time4
## 1 01 23 23 NA NA
## 2 02 21 21 21 NA
## 3 03 22 22 25 NA
## 4 04 NA NA NA NA
## 5 05 29 29 20 NA
## 6 06 NA NA 15 22
## 7 07 NA NA 11 NA
## 8 08 1 NA NA 2
解决方案:
ris <- seq_len(nrow(df));
cis <- grep('^Time',names(df));
timemat <- as.matrix(df[cis]);
nacols <- as.data.frame(ifelse(is.na(timemat),NA,col(timemat)));
nacols;
## Time1 Time2 Time3 Time4
## 1 1 2 NA NA
## 2 1 2 3 NA
## 3 1 2 3 NA
## 4 NA NA NA NA
## 5 1 2 3 NA
## 6 NA NA 3 4
## 7 NA NA 3 NA
## 8 1 NA NA 4
for (ci in seq_len(ncol(timemat))) {
off <- abs(nacols-ci);
best <- which(off==do.call(pmin,c(off,na.rm=T)),arr.ind=T);
df[cis[ci]] <- timemat[matrix(c(ris,best[match(ris,best[,'row']),'col']),nrow(df))];
};
df;
## ID Time1 Time2 Time3 Time4
## 1 01 23 23 23 23
## 2 02 21 21 21 21
## 3 03 22 22 25 25
## 4 04 NA NA NA NA
## 5 05 29 29 20 20
## 6 06 15 15 15 22
## 7 07 11 11 11 11
## 8 08 1 1 2 2
Rcpp 解决方案:
library(Rcpp);
cppFunction('
IntegerMatrix fillDFNAsWithNearestInRow(DataFrame df, IntegerVector cis ) {
IntegerMatrix res(df.nrows(),cis.size());
if (df.nrows()==0 || cis.size()==0) return res;
IntegerVector cis0 = clone(cis); for (int cisi = 0; cisi < cis0.size(); ++cisi) --cis0[cisi]; // correct from R 1-based to Rcpp 0-based
for (int cisi = 0; cisi < cis0.size(); ++cisi) {
IntegerVector colCur = df[cis0[cisi]];
for (int ri = 0; ri < colCur.size(); ++ri) {
if (!IntegerVector::is_na(colCur[ri])) {
res(ri,cisi) = colCur[ri];
continue;
}
int leftOk;
int rightOk;
IntegerVector colLeft;
IntegerVector colRight;
bool set = false; // assumption
for (int off = 1; (leftOk = cisi-off>=0, rightOk = cisi+off<cis0.size(), leftOk ) || rightOk; ++off) {
if (leftOk && (colLeft = df[cis0[cisi-off]], !IntegerVector::is_na(colLeft[ri]))) {
res(ri,cisi) = colLeft[ri];
set = true;
break;
} else if (rightOk && (colRight = df[cis0[cisi+off]], !IntegerVector::is_na(colRight[ri]))) {
res(ri,cisi) = colRight[ri];
set = true;
break;
}
}
if (!set) res(ri,cisi) = NA_INTEGER;
}
}
return res;
}
');
df <- data.frame(ID=c('01','02','03','04','05','06','07','08'),Time1=c(23L,21L,22L,NA,29L,NA,NA,1L),Time2=c(23L,21L,22L,NA,29L,NA,NA,NA),Time3=c(NA,21L,25L,NA,20L,15L,11L,NA),Time4=c(NA,NA,NA,NA,NA,22L,NA,2L),stringsAsFactors=F);
cis <- grep('^Time',names(df));
df[cis] <- fillDFNAsWithNearestInRow(df,cis);
df;
## ID Time1 Time2 Time3 Time4
## 1 01 23 23 23 23
## 2 02 21 21 21 21
## 3 03 22 22 25 25
## 4 04 NA NA NA NA
## 5 05 29 29 20 20
## 6 06 15 15 15 22
## 7 07 11 11 11 11
## 8 08 1 1 2 2