【问题标题】:r - copy missing values from other variablesr - 从其他变量中复制缺失值
【发布时间】:2016-04-19 16:32:31
【问题描述】:

简单的问题,但我不知道如何执行以下操作。这是我的数据:

ID    Time1    Time2    Time3    Time4
01    23       23       NA       NA  
02    21       21       21       NA
03    22       22       25       NA
04    29       29       20       NA
05    NA       NA       15       22
06    NA       NA       11       NA

现在,我想用其他变量中可用的数据替换缺失值 (NA)。重要的是,我需要 r 取“最接近”缺失数据点的值。例如,对于 ID 5,Time1 和 Time2 应该是“15”(而不是“22”)。

像这样:

ID    Time1    Time2    Time3    Time4
01    23       23       23       23  
02    21       21       21       21
03    22       22       25       25
04    29       29       20       20
05    15       15       15       22
06    11       11       11       11

我尝试过 ifelse 语句,但没有成功。

谢谢!

【问题讨论】:

  • 你如何打破“最亲密”的关系?例如如果您有Time1Time3,但没有Time2,该怎么办?
  • 感谢您的评论,确实非常重要!首选顺序是从左到右(即按时间顺序:Time1>Time2>Time3>Time4)
  • 如果“Time1”和“Time4”非NA(“Time2”和“Time3”为NA),“Time2”==“Time1”和“Time3”==“Time4”?您能否在示例中添加任何边缘情况以及处理方式?
  • 没错!这样每个变量都与其最接近的可用值/时间点匹配。即,时间 2 == 时间 1,时间 3 == 时间 4
  • 我当然可以接受的一种方法是从 Time2 开始/将 NA 与 Time1、Time3(与 Time 2 匹配)、Time4(与 Time3 匹配)的值匹配。比相反的方式(即匹配 Time3 和 Time4 等等)。重复直到完成。

标签: r missing-data


【解决方案1】:

使用 data.table 的滚动连接和set

library(data.table)
good = as.data.table( which(!is.na(df[-1]), arr.ind = TRUE) )
all = CJ(row = seq(nrow(df)), col = seq(2L, ncol(df)))
good$col = good$col + 1L
good$col_src = good$col

changes = good[all, on = c("row", "col"), roll="nearest"][ col != col_src ]

changes[, {
  set(df, i = row, j = col, value = df[[ col_src ]][row])
  NULL
}, by=.(col,col_src)]

# based on input from bgoldst's answer
   ID  1  2  3  4
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

我们找到所有要切换的条目,然后通过引用 set 进行修改。我不确定roll="nearest" 是如何处理领带的,但我确信可以对其进行调整。

【讨论】:

  • 非常感谢!
【解决方案2】:

这比看起来要困难得多。我构建了一个一次处理一列的解决方案,采用所有时间列索引和当前列索引之间的绝对距离的pmin(),使用na.rm=T 参数剥离NA。然后可以使用索引矩阵将结果用于索引原始时间列,然后可以将其分配给目标 data.frame 中的当前列索引。

这种设计的一个优点是它在行上完全矢量化。换句话说,它不会一次迭代一行。这对于非常多行的输入可能是一个优势。另一方面,该解决方案确实涉及构建与所有时间列(timematnacolsoff)平行的矩阵,这对于大型输入可能会很昂贵。它基本上是用内存来节省 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

【讨论】:

  • 非常感谢。很抱歉再次打扰您,但是您是否认为这可以适应不同的变量组?也就是说,我有 Time1_A Time2_A Time3_A Time4_A Time1_B Time2_B Time3_B Time4_BTime1_C 等等所以我希望在变量组中替换 NA,但显然不是在它们之间(“B”变量值不适合替换“A”变量)
  • 是的,您可以将cis 分配给您要执行填充的列索引子集。如果有多个组,您可以多次运行代码,每次使用不同的cis 值。
  • 工作就像一个魅力。非常感谢,有史以来最有帮助的回复!
【解决方案3】:

又一次尝试。尽可能分解:(1)从左到右循环一次,向前携带最后一个非NA值,并且记录非NA被替换的每个NA的位置,(2)再次从右到左循环( a) 向后替换携带非 NA 的 NA,和 (b) 比较替换每个 NA 的非 NA 与当前非 NA 的距离,并保留或替换。尽管有两个显式循环,但计算涉及length == nrow(x) 的向量。

ff = function(x)
{    
    taken_from = lapply(seq_along(x), rep_len, nrow(x))
    nas = lapply(x, is.na)

    #loop left -> right 
    # carry forward non-NAs and record which non-NA replaced NA
    last_nona = !nas[[1L]]
    for(j in 2:length(x)) {
        i = which(nas[[j]] & last_nona)
        x[[j]][i] = x[[j - 1L]][i]
        taken_from[[j]][i] = taken_from[[j - 1L]][i]
        last_nona = !is.na(x[[j]])
    }

    #loop right -> left
    #if NA and not replace carry the previous non-NA backward
    #else compare which non-NA is nearer and replace appropriately
    last_nona = !nas[[length(x)]]
    for(j in (length(x) - 1L):1L) {
        i1 = which(nas[[j]] & last_nona)
        i = i1[(j - taken_from[[j]][i1]) > (taken_from[[(j + 1L)]][i1] - j)]
        ii = i1[j == taken_from[[j]][i1]]
        taken_from[[j]][i] = taken_from[[j + 1L]][i]
        taken_from[[j]][ii] = taken_from[[j + 1L]][ii]
        x[[j]][i] = x[[j + 1L]][i]
        x[[j]][ii] = x[[j + 1L]][ii]
        last_nona = !is.na(x[[j]])
    }

    return(x)
}

使用 bgoldst 的数据:

ff(df[-1L])
#  Time1 Time2 Time3 Time4
#1    23    23    23    23
#2    21    21    21    21
#3    22    22    25    25
#4    NA    NA    NA    NA
#5    29    29    20    20
#6    15    15    15    22
#7    11    11    11    11
#8     1     1     2     2

以及必要的基准测试:

set.seed(911)            
DAT = as.data.frame(matrix(sample(c(NA, 0:10), 1e7, TRUE), 1e6, 10))
system.time({ ansff = ff(DAT) })
#   user  system elapsed 
#   0.82    0.38    1.75 
system.time({ ansbgoldst1 = bgoldst1(DAT) })
#   user  system elapsed 
#  20.96    7.53   42.04 
system.time({ ansbgoldst2 = bgoldst2(DAT) })
#   user  system elapsed 
#   0.97    0.25    1.64 
sf1 = system.time({ ansfrank = frank(DAT) }); sf2 = system.time( copy(DAT) )
sf1 - sf2
#   user  system elapsed 
#   5.84    1.46    8.59 
all.equal(ansff, ansbgoldst1)
#[1] TRUE
all.equal(ansbgoldst1, ansbgoldst2)
#[1] TRUE
all.equal(ansbgoldst2, ansfrank)
#[1] TRUE

功能:

bgoldst1 = function(x)
{
    ris = seq_len(nrow(x))
    xm = as.matrix(x)
    nacols = as.data.frame(lapply(seq_along(x), function(i) { x[[i]][!is.na(x[[i]])] = i; x[[i]] }))
    for(ci in seq_along(x)) {
        off = abs(nacols - ci)
        best = which(off == do.call(pmin, c(off, na.rm = TRUE)), arr.ind = TRUE)
        x[ci] = xm[matrix(c(ris, best[match(ris, best[, "row"]), "col"]), nrow(x))]
    }
    x
}

bgoldst2 = function(x) 
{
    ans = as.data.frame(fillDFNAsWithNearestInRow(x, seq_along(x)))
    names(ans) = names(x)
    ans
}

frank = function(x)
{
    x = copy(x)
    good = as.data.table(which(!is.na(x), arr.ind = TRUE))
    all = CJ(row = seq_len(nrow(x)), col = seq_len(ncol(x)))
    good$col = good$col
    good$col_src = good$col

    changes = good[all, on = c("row", "col"), roll = "nearest"][col != col_src]

    changes[, {
            set(x, i = row, j = col, value = x[[col_src]][row])
            NULL
            }, by = .(col, col_src)]
    x
}

【讨论】:

  • @bgoldst :我看到相反的情况;使用上面的“DAT”和mDAT = as.matrix(DAT),我得到system.time({ nacols1 = as.data.frame(ifelse(is.na(mDAT), NA, col(mDAT))) }) --> 经过1.16 和system.time({ nacols2 = as.data.frame(lapply(seq_along(DAT), function(i) { DAT[[i]][!is.na(DAT[[i]])] = i; DAT[[i]] })) }) --> 经过0.15。老实说,我首先进行了更改,以避免创建另一个大的col(x),并将ifelse(is.na(.. 替换为显式"["
【解决方案4】:

这是一个简单的解决方案:

x <-read.table(text="ID    Time1    Time2    Time3    Time4
01    23       23       NA       NA  
02    21       21       21       NA
03    22       22       25       NA
04    29       29       20       NA
05    NA       NA       15       22
06    NA       NA       11       NA", header=TRUE)

x <- as.matrix(x[,-1])

dofill <- function(r){
  PREV <- c(NA, suppressWarnings(head(r, -1)))
  NEXT <- c(tail(r,-1), NA)
  r[is.na(r)] <- PREV[is.na(r)]
  r[is.na(r)] <- NEXT[is.na(r)]
  r
}

rlefill <- function(r){
  r[is.na(r)] <- "NA"
  rle1 <- rle(r)
  rle1$values <- dofill(as.numeric(rle1$values))
  inverse.rle(rle1)
}

t(apply(x, 1, rlefill))

dofill 简单地将所有 NA 替换为前一个值,并将所有剩余的 NA 替换为下一个值。

rlefill 需要将一系列 NA 转换为“一个大 NA”。

当然,如果你有更多的时间点,你可能需要类似...

cis <- grep('^Time',names(df))
timemat <- as.matrix(df[cis]);

...即从数据框中提取相关部分的更通用的解决方案。

(现在我意识到这并不完全符合您的要求 - 如果可用,我的解决方案始终使用前面的值,即使后面的值更接近时间。它对您的示例数据集没有影响但它可能会对真实数据产生影响。)

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 2021-10-03
    • 1970-01-01
    • 2013-05-21
    • 2019-03-11
    • 1970-01-01
    • 2021-08-10
    • 1970-01-01
    相关资源
    最近更新 更多