Question

这个问题与我之前发现的（已解决）帖子here有关，我正在寻找一种方法，以便在速度问题时使用Base R来保留NA值的最后一个已知值。

与那时不同，我现在有一个矩阵而不是列向量，之前标记为解决方案的方法在这里不起作用。数据位于数据框x：

中

x=data.frame(c("2015-05-31","2015-06-30","2015-07-31","2015-08-31"),c(NA,200,NA,NA),c(NA,NA,50,NA))
colnames(x)=c("Date","AAPL","IBM")
x[,1]=as.Date(x[,1],origin="1970-01-01")
x
  Date      AAPL IBM
2015-05-31   NA  NA
2015-06-30  200  NA
2015-07-31   NA  50
2015-08-31   NA  NA


index = !is.na(x)
x[,] = x[index][cumsum(index)]
x
   Date          AAPL IBM
2015-05-31 2015-08-31 200
2015-06-30        200 200
2015-07-31        200  50
2015-08-31        200  50

这个错了。 AAPL的最后一个已知值转移到IBM，最后一个日期转移到AAPL。

我需要

y
   Date           AAPL IBM
2015-05-31          0  0
2015-06-30        200  0
2015-07-31        200  50
2015-08-31        200  50

或

z
   Date           AAPL IBM
2015-05-31         NA  NA
2015-06-30        200  NA
2015-07-31        200  50
2015-08-31        200  50

非常感谢任何帮助。

更新

我相信

index = !is.na(x)
x[,] = x[index][cumsum(index)]

如果有一种方法可以将NA的每个第一次出现替换为0，那么

将会起作用。问题是每个NA可以从不同的行开始（不一定是示例中的第一行）。

UPDATE2：

非常感谢下面的众多帖子。我的特定情况的解决方案很简单，因为将每个第一行的NA替换为0（而不是它的第一次出现）就足够了：

插入

x[1,is.na(x[1,])] = 0

前面的

index = !is.na(x)
x[,] = x[index][cumsum(index)]

将完成这项工作：

   Date     AAPL IBM
2015-05-31    0   0
2015-06-30  200   0
2015-07-31  200  50
2015-08-31  200  50

我仍然不愿意将自己的帖子标记为解决方案（尽管已经解决了这个问题）。

Answer 1

您需要独立地对数据帧的每个向量应用前馈操作。这需要for循环或apply语句（实际上是相同的，但可能会进行适度优化）

以下工作并具有您的基本R要求：

x=data.frame(c("2015-05-31","2015-06-30","2015-07-31","2015-08-31"),c(NA,200,NA,NA),c(NA,NA,50,NA))
colnames(x)=c("Date","AAPL","IBM")
x[,1]=as.Date(x[,1],origin="1970-01-01")
x

base_locf <- function(y, na = NA){
  initial_na <- min(which(!is.na(y)))
  i1 <- !is.na(y)
  t <- y[i1][cumsum(i1)]
  if (is.na(y[1])) t <- c(rep(na, initial_na -1), t)
  t
}

as.data.frame(lapply(x, base_locf), 
              stringsAsFactors = FALSE)

as.data.frame(lapply(x, base_locf, na=0),
              stringsAsFactors = FALSE)

虽然base_locf似乎比zoo::na.locf更快，但我确信它更强大，并且可以更好地响应代码中的错误和问题。（EDITED：使用更大的（ish）数据集）

library(microbenchmark)
library(zoo)

DF <- data.frame(x = rnorm(10000),
                 y = rnorm(10000, 5, 3),
                 z = rnorm(10000, 10, 2.5))
set.seed(123)
DF$x[sample(1:10000, 500)] <- NA
DF$y[c(1, sample(1:10000, 1000))] <- NA
DF$z[sample(1:10000, 2000)] <- NA
microbenchmark(
  base = as.data.frame(lapply(x, base_locf),
                       stringsAsFactors = FALSE),
  zoo = as.data.frame(lapply(x, na.locf, na.rm = FALSE),
                      stringsAsFactors = FALSE),
  zoo_plain = na.locf(DF, na.rm=FALSE),
  loop = for(i in seq_along(DF)) DF[[i]] <- base_locf(DF[[i]])
)

Unit: microseconds
      expr      min        lq     mean    median       uq      max neval cld
      base  751.292  821.8170 1644.690  869.4695 1534.255 54234.95   100  a 
       zoo 1905.208 2040.3940 3657.343 2743.0080 3044.610 54669.54   100  a 
 zoo_plain 3697.224 4709.7970 6594.909 4994.0965 5316.079 62811.17   100   b
      loop  608.189  649.5365 1557.218  697.0420 1493.640 56144.26   100  a

因为我很好奇在

中强迫更多缺失值会发生什么

DF <- data.frame(x = rnorm(10000),
                 y = rnorm(10000, 5, 3),
                 z = rnorm(10000, 10, 2.5))
set.seed(123)
DF$x[sample(1:10000, 2000)] <- NA
DF$y[c(1, sample(1:10000, 4000))] <- NA
DF$z[sample(1:10000, 6000)] <- NA

microbenchmark(
  base = as.data.frame(lapply(DF, base_locf),
                       stringsAsFactors = FALSE),
  zoo = as.data.frame(lapply(DF, na.locf, na.rm = FALSE),
                      stringsAsFactors = FALSE),
  zoo_plain = na.locf(DF, na.rm=FALSE),
  loop = for(i in seq_along(DF)) DF[[i]] <- base_locf(DF[[i]])
)

Unit: microseconds
      expr      min        lq     mean    median       uq      max neval cld
      base  788.534  824.3100 1722.840  883.5450 1639.089 53433.80   100  a 
       zoo 1875.884 2080.4215 4233.562 2722.4800 2925.405 60464.04   100  ab
 zoo_plain 3683.735 4741.4670 6600.050 4961.8400 5207.432 62354.59   100   b
      loop  636.634  679.7405 1661.977  743.0815 1525.017 60177.84   100  a

在矩阵中没有循环的情况下携带最后已知的值

1 个答案: