基于“变化率”估计时间序列数据框中的缺失值答案

【问题标题】：Estimating missing values in time-series data frame based on a "rate of change"基于“变化率”估计时间序列数据框中的缺失值
【发布时间】：2016-02-10 21:01:58
【问题描述】：

我正在尝试使用 R 中的循环来估计值，这些值将根据与我最后一个值相乘的变化率（“率”）来替换我的数据帧中的 NA（好吧，这很令人困惑，但请参考到下面的例子）。这与我的数据类似：

l1 <- c(NA,NA,NA,27,31,0.5)
l2 <- c(NA,8,12,28,39,0.5)
l3 <- c(NA,NA,NA,NA,39,0.3)
l4 <- c(NA,NA,11,15,31,0.2)
l5 <- c(NA,NA,NA,NA,51,0.9)

data <- as.data.frame(rbind(l1,l2,l3,l4,l5))
colnames(data) <- c("dbh1","dbh2","dbh3","dbh4","dbh5","rate")

所以我创建了一个循环来识别每行中的第一个 no-NA 值，然后使用该值根据“速率”估计其先前的值。例如，在第 1 行中，第一个 NA 值将替换为 "27-(0.5*3)"，然后第二个将替换为 "27-(0.5*2) " 和第三个 "27-(0.5*1)"。这是我想出的循环。我知道第一部分（外部循环）有效，但内部无效：

for (i in 1: nrow(data)) {
  dbh.cols <- data3[i,c("dbh1","dbh2","dbh3","dbh4","dbh5")]

  sample.year <- which(dbh.cols != "NA")

  data$first.dbh[i] <- min(dbh.cols, na.rm = T)
  data$first.index[i] <- min(sample.year)

  for (j on 1: (min(sample.year)-1)) {
    ifelse(is.na(data[i,j]), min(dbh.cols, na.rm = T) - (min(sample.year)-j)*rate[i,j], data[i,j])
  }
}

我不擅长编程，所以可能我的“ifelse”内部循环策略太奇怪（而且错误），但我就是想不出其他可以在这里工作的东西......有什么建议吗？

【问题讨论】：

标签： r loops time-series na

【解决方案1】：

1) 这不使用显式循环，仅使用apply。它假设所有 NA 都在给出的示例中领先。

fillIn <- function(x) {
   rate <- tail(x, 1)
   n <- sum(is.na(x)) # no of NAs
   c(x[n+1] - rate * seq(n, 1), na.omit(x))
}
replace(data, TRUE, t(apply(data, 1, fillIn)))

给予：

   dbh1 dbh2 dbh3 dbh4 dbh5 rate
l1 25.5 26.0 26.5 27.0   31  0.5
l2  7.5  8.0 12.0 28.0   39  0.5
l3 37.8 38.1 38.4 38.7   39  0.3
l4 10.6 10.8 11.0 15.0   31  0.2
l5 47.4 48.3 49.2 50.1   51  0.9

2) 这是第二种方法，它使用 zoo 包中的 na.approx。它不需要apply。这里data1与data的内容相同，只是第一列填了，其他的NA都保留了。最后一行使用na.approx线性填充剩余的NA。

library(zoo)

NAs <- rowSums(is.na(data))
data1 <- cbind( data[cbind(1:nrow(data), NAs + 1)] - data$rate * NAs, data[-1] )
replace(data, TRUE, t(na.approx(t(data1))))

给予：

   dbh1 dbh2 dbh3 dbh4 dbh5 rate
l1 25.5 26.0 26.5 27.0   31  0.5
l2  7.5  8.0 12.0 28.0   39  0.5
l3 37.8 38.1 38.4 38.7   39  0.3
l4 10.6 10.8 11.0 15.0   31  0.2
l5 47.4 48.3 49.2 50.1   51  0.9

2a) (2) 的变体使用中间行中的na.locf 将每行中的第一个非NA 提前。第一行和最后一行是一样的。

library(zoo)

NAs <- rowSums(is.na(data))
data1 <- cbind(na.locf(t(data), fromLast = TRUE)[1, ] - data$rate * NAs, data[-1])
replace(data, TRUE, t(na.approx(t(data1))))

【讨论】：

更简洁。我喜欢这个！
谢谢，G. Grothendieck！天哪，你可以把我的 100 行代码变成 10 行……呵呵

【解决方案2】：

您不需要为此使用多个 for 循环。这是一些简化的代码，可以为 for 循环执行您想要的操作。明确地使用您的 data，我们需要从每一行中获取第一个非 NA 值。

for_estimate <- apply(data, 1, function(x) x[min(which(is.na(x) == FALSE))])

其次，我们需要根据有多少 NA 值来确定每行的速率乘以哪个整数。

# total number of NA values per row
n_na <- apply(data,1, function(x) sum(is.na(x)) )

# make it a matrix with a 0's appended on
n_na <- matrix(c(n_na, rep(0, nrow(data) * (ncol(data)-1))), 
           nrow = nrow(data), ncol = ncol(data)-1)

# fill in the rest of the matrix
for(i in 2:ncol(n_na)){
  n_na[,i] <- n_na[,i-1] -1
}

一旦我们有了，我们就可以使用此代码以您感兴趣的方式回填 NA 值。

for(i in (ncol(data)-1):1){
  if(sum(is.na(data[,i]))>0){
  to_fill <- which(is.na(data[,i])==TRUE)

  data[to_fill,i] <- for_estimate[to_fill] - (data$rate[to_fill]*(n_na[to_fill,i])
  }

}

输出

   dbh1 dbh2 dbh3 dbh4 dbh5 rate
l1 25.5 26.0 26.5 27.0   31  0.5
l2  7.5  8.0 12.0 28.0   39  0.5
l3 37.8 38.1 38.4 38.7   39  0.3
l4 10.6 10.8 11.0 15.0   31  0.2
l5 47.4 48.3 49.2 50.1   51  0.9

【讨论】：