用尾随行值乘以增长率填充 NA 值？

Question

用以前的值乘以 (1 + growth) 填充 NA 值的好方法是什么？

df <- data.frame(
  year = 0:6,
  price1 = c(1.1, 2.1, 3.2, 4.8, NA, NA, NA),
  price2 = c(1.1, 2.1, 3.2, NA, NA, NA, NA)
)
growth <- .02

在这种情况下，我希望price1 中的缺失值用4.8*1.02、4.8*1.02^2 和4.8*1.02^3 填充。同样，我希望price2 中的缺失值用3.2*1.02、3.2*1.02^2、3.2*1.02^3 和3.2*1.02^4 填充。

我已经尝试过了，但我认为它需要设置为以某种方式重复（apply?）：

library(dplyr)
df %>%
  mutate(price1 = ifelse(is.na(price1),
    lag(price1) * (1 + growth), price1
  ))

我没有将dplyr 用于其他任何东西（还），所以来自base R 或plyr 或类似的东西将不胜感激。

Answer 1

你可以试试这样的功能

    test <- function(x,n) {
      if (!is.na(df[x,n]))    return (df[x,n])
      else           return (test(x-1,n)*(1+growth))
    }


a=1:nrow(df)


lapply(a, FUN=function(i) test(i,2))

unlist(lapply(a, FUN=function(i) test(i,2)))

[1] 1.100000 2.100000 3.200000 4.800000 4.896000 4.993920 5.093798

Answer 2

以下基于rle的解决方案适用于任何位置的NA，并且不依赖循环来填充缺失值：

NAgrow.rle <- function(x) {
  if (is.na(x[1]))  stop("Can't have NA at beginning")
  r <- rle(is.na(x))
  na.loc <- which(r$values)
  b <- rep(cumsum(r$lengths)[na.loc-1], r$lengths[na.loc])
  x[is.na(x)] <- ave(x[b], b, FUN=function(y) y[1]*(1+growth)^seq_along(y))
  x
}
df[,-1] <- lapply(df[,-1], NAgrow.rle)
#   year   price1   price2
# 1    0 1.100000 1.100000
# 2    1 2.100000 2.100000
# 3    2 3.200000 3.200000
# 4    3 4.800000 3.264000
# 5    4 4.896000 3.329280
# 6    5 4.993920 3.395866
# 7    6 5.093798 3.463783

我将添加两个使用 for 循环的额外解决方案，一个在 base R 中，一个在 Rcpp 中：

NAgrow.for <- function(x) {
  for (i in which(is.na(x))) {
    x[i] <- x[i-1] * (1+growth)
  }
  x
}

library(Rcpp)
cppFunction(
"NumericVector NAgrowRcpp(NumericVector x, double growth) {
  const int n = x.size();
  NumericVector y(x);
  for (int i=1; i < n; ++i) {
    if (R_IsNA(x[i])) {
      y[i] = (1.0 + growth) * y[i-1];
    }
  }
  return y;
}")

基于rle（crimson 和josilber.rle）的解决方案所花费的时间大约是基于 for 循环的简单解决方案（josilber.for）的两倍，并且正如预期的那样，Rcpp 解决方案是最快的，正在运行大约 0.002 秒。

set.seed(144)
big.df <- data.frame(ID=1:100000,
                     price1=sample(c(1:10, NA), 100000, replace=TRUE),
                     price2=sample(c(1:10, NA), 100000, replace=TRUE))
crimson <- function(df) apply(df[,-1], 2, function(x){
  if(sum(is.na(x)) == 0){return(x)}
  ## updated with optimized portion from @josilber
  r <- rle(is.na(x))
  na.loc <- which(r$values)
  b <- rep(cumsum(r$lengths)[na.loc-1], r$lengths[na.loc])
  lastValIs <- 1:length(x)
  lastValIs[is.na(x)] <- b
  x[is.na(x)] <-
    sapply(which(is.na(x)), function(i){
      return(x[lastValIs[i]]*(1 + growth)^(i - lastValIs[i]))
    })
  return(x)
})
ggrothendieck <- function(df) {
  growthfun <- function(x, y) if (is.na(y)) (1+growth)*x else y
  lapply(df[,-1], Reduce, f = growthfun, acc = TRUE)
}
josilber.rle <- function(df) lapply(df[,-1], NAgrow.rle)
josilber.for <- function(df) lapply(df[,-1], NAgrow.for)
josilber.rcpp <- function(df) lapply(df[,-1], NAgrowRcpp, growth=growth)
library(microbenchmark)
microbenchmark(crimson(big.df), ggrothendieck(big.df), josilber.rle(big.df), josilber.for(big.df), josilber.rcpp(big.df))
# Unit: milliseconds
#                   expr        min         lq       mean     median         uq         max neval
#        crimson(big.df)  98.447546 131.063713 161.494366 152.477661 183.175840  379.643222   100
#  ggrothendieck(big.df) 437.015693 667.760401 822.530745 817.864707 925.974019 1607.352929   100
#   josilber.rle(big.df)  59.678527 115.220519 132.874030 127.476340 151.665657  262.003756   100
#   josilber.for(big.df)  21.076516  57.479169  73.860913  72.959536  84.846912  178.412591   100
#  josilber.rcpp(big.df)   1.248793   1.894723   2.373469   2.190545   2.697246    5.646878   100

Answer 3

使用Reduce可以得到一个紧凑的基础R解决方案：

growthfun <- function(x, y) if (is.na(y)) (1+growth)*x else y
replace(df, TRUE, lapply(df, Reduce, f = growthfun, acc = TRUE))

给予：

  year   price1   price2
1    0 1.100000 1.100000
2    1 2.100000 2.100000
3    2 3.200000 3.200000
4    3 4.800000 3.264000
5    4 4.896000 3.329280
6    5 4.993920 3.395866
7    6 5.093798 3.463783

注意：问题中的数据没有非尾随 NA 值，但如果有的话，我们可以使用 zoo 中的 na.fill 首先将尾随 NA 替换为特殊值，例如作为 NaN，并寻找它而不是 NA：

library(zoo)

DF <- as.data.frame(na.fill(df, c(NA, NA, NaN)))
growthfun <- function(x, y) if (is.nan(y)) (1+growth)*x else y
replace(DF, TRUE, lapply(DF, Reduce, f = growthfun, acc = TRUE))

Answer 4

看起来dplyr 无法处理访问新分配的滞后值。这是一个即使NA 位于列中间也应该有效的解决方案。

df <- apply(
  df, 2, function(x){
    if(sum(is.na(x)) == 0){return(x)}
    ## updated with optimized portion from @josilber
    r <- rle(is.na(x))
    na.loc <- which(r$values)
    b <- rep(cumsum(r$lengths)[na.loc-1], r$lengths[na.loc])
    lastValIs <- 1:length(x)
    lastValI[is.na(x)] <- b
    x[is.na(x)] <-
      sapply(which(is.na(x)), function(i){
        return(x[lastValIs[i]]*(1 + growth)^(i - lastValIs[i]))
      })
    return(x)
  })

Answer 5

假设只有尾随 NA：

NAgrow <- function(x,growth=0.02) {
    isna <- is.na(x)
    lastval <- tail(x[!isna],1)
    x[isna] <- lastval*(1+growth)^seq(sum(isna))
    return(x)
}

如果还有内部 NA 值，这将变得有点棘手。

应用于除第一列之外的所有列：

df[-1] <- lapply(df[-1],NAgrow)

##   year   price1   price2
## 1    0 1.100000 1.100000
## 2    1 2.100000 2.100000
## 3    2 3.200000 3.200000
## 4    3 4.800000 3.264000
## 5    4 4.896000 3.329280
## 6    5 4.993920 3.395866
## 7    6 5.093798 3.463783