使用另一个时间序列的增长率插值时间序列（替换 NA）

Question

假设我有一个这样的数据集：

trt <- data.table(group = rep(c("a","b"), each = 5), 
                  val1= c(60,62,NA,NA,71, NA, 21,22,NA,25),
                  val2 = c(1,1,1,NA,2, 1,1,NA,NA,2),
                  reflev = rep(c(1.01, 1.03, 1.061, 1.104,1.159), 2))
trt[ , ref:= round(reflev/shift(reflev), 2), by = group]


> trt
    group val1 val2 reflev  ref
 1:     a   60    1  1.010   NA
 2:     a   62    1  1.030 1.02
 3:     a   NA    1  1.061 1.03
 4:     a   NA   NA  1.104 1.04
 5:     a   71    2  1.159 1.05
 6:     b   NA    1  1.010   NA
 7:     b   21    1  1.030 1.02
 8:     b   22   NA  1.061 1.03
 9:     b   NA   NA  1.104 1.04
10:     b   25    2  1.159 1.05

在每个组中，我想通过将之前的可用值（例如 shift(val1) 或 lag(val1)）与ref 列中的值。如果在一个非 NA 值之后有多个 NA 出现在一个序列中，则应使用之前的插值作为起点对它们进行插值。

所以，这是我想象的计算方式：

    group val1          val2         reflev  ref
 1:     a   60            1           1.010   NA
 2:     a   62            1           1.030 1.02
 3:     a   62*1.03       1           1.061 1.03
 4:     a   62*1.03*1.04  1*1.04      1.104 1.04
 5:     a   71            2           1.159 1.05
 6:     b   NA            1           1.010   NA
 7:     b   21            1           1.030 1.02
 8:     b   22           1*1.03       1.061 1.03
 9:     b   22*1.04      1*1.03*1.04  1.104 1.04
10:     b   25            2           1.159 1.05

有什么想法吗？我能想到的一切都非常肮脏，并且会涉及两个循环，一个用于组，一个用于所需的列。

Answer 1

这是我的“快速肮脏”解决方案。很高兴听到改进的可能性：

interpolate <- function(data, int.column){

  for(row in 2:nrow(data)){
    if(is.na(data[row,get(int.column)]) & !is.na(data[row-1, get(int.column)])){
      data[[int.column]][row] <- data[row,ref]*data[[int.column]][row-1]
      }
  }
  return(data[ , get(int.column)])
}

我对@9​​87654322@（要插入的列的名称）进行了如此奇怪的调用，因为我没有设法从适当的环境中调用 int.column 并且总是出错）。

然后 trt[ , val1:= interpolate(.SD,"val1"), by = group] 用于单列的插值或

columns.to.int <- c("val1", "val2")
trt[ , (columns.to.int):= lapply(columns.to.int, function(x)interpolate(.SD,x)), by = group]

多个。

有没有更好的办法？

Answer 2

这是另一种选择：

cols <- paste0("val", 1L:2L)
trt[, paste0("prev", cols) := lapply(.SD, nafill, type="locf"), group, .SDcols=cols]

trt[, outval1 := fifelse(is.na(val1), prevval1 * cumprod(ref), val1), .(group, rleid(is.na(val1)))]

trt[, outval2 := fifelse(is.na(val2), prevval2 * cumprod(ref), val2), .(group, rleid(is.na(val2)))]

---

编辑多个val 列。也许是这样的：

cols <- paste0("V", 1L:30L)
for (x in cols) {
    trt[, c("prev", "ri") := {
            v <- get(x)
            .(nafill(v, "locf"), rleid(is.na(v)))
        }, group]
    trt[, paste0("out", x) := {
            v <- get(x)
            fifelse(is.na(v), prev * cumprod(ref), v)
        }, .(group, ri)]
}

或者使用melt会更快：

mDT <- melt(trt[, rn := .I], measure.vars=patterns("^V"))
mDT[, pv := nafill(value, "locf"), group]
mDT[, nv := fifelse(is.na(value), pv * cumprod(ref), value),
    .(group, variable, rleid(is.na(value)))]
dcast(mDT, rn + group + reflev + ref ~ variable, value.var="nv")

样本数据：

library(data.table)
set.seed(0L)
nc <- 30L
nr <- 3e3L
trt <- data.table(group = rep(1:(nr/5L), each=5L), 
    reflev = 1+runif(nr)/10,
    as.data.table(matrix(sample(c(NA,10,20,30), nc*nr, TRUE), ncol=nc)))
trt[ , ref:= round(reflev/shift(reflev), 2), by = group]