基于 "rate of change" 估计时间序列数据框中的缺失值

Question

我正在尝试使用 R 中的循环来估计将根据乘以我的最后一个值的变化率 ("rate") 替换我的数据框中的 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 值，然后使用该值根据 "rate" 估计其先前的值。因此，例如，在第 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" 的内部循环策略太奇怪了（而且是错误的），但我想不出还有什么可以在这里工作的……有什么建议吗？

Answer 1

您不需要为此使用多个 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

Answer 2

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))))

基于 "rate of change" 估计时间序列数据框中的缺失值

Estimating missing values in time-series data frame based on a "rate of change"

loops

r

time-series

na