时间戳

首页 > 解决方案 > 如何有条件地检查和替换 xts 对象中的数据？

r - 如何有条件地检查和替换 xts 对象中的数据？

问题描述

这是一个可重现的数据集。问题是在一系列 NA 之间找到 1 或 2 个连续的非 NA 值并将它们分配为 NA。如果超过 2 个，则无需执行任何操作。

set.seed(55)
data <- rnorm(10)
dates <- as.POSIXct("2019-03-18 10:30:00", tz = "CET") + 0:9*60

R <- xts(x = data, order.by = dates)
colnames(R) <- "R-factor"
R[c(1, 3, 6, 10)] <- NA
R

输出：

                        R-factor
2019-03-18 10:30:00           NA
2019-03-18 10:31:00 -1.812376850
2019-03-18 10:32:00           NA
2019-03-18 10:33:00 -1.119221005
2019-03-18 10:34:00  0.001908206
2019-03-18 10:35:00           NA
2019-03-18 10:36:00 -0.505343855
2019-03-18 10:37:00 -0.099234393
2019-03-18 10:38:00  0.305353199
2019-03-18 10:39:00           NA

预期结果：

                        R-factor
2019-03-18 10:30:00           NA
2019-03-18 10:31:00           NA
2019-03-18 10:32:00           NA
2019-03-18 10:33:00           NA
2019-03-18 10:34:00           NA
2019-03-18 10:35:00           NA
2019-03-18 10:36:00 -0.505343855
2019-03-18 10:37:00 -0.099234393
2019-03-18 10:38:00  0.305353199
2019-03-18 10:39:00           NA

我编写了一个带有 for-loop 的函数，该函数适用于小型数据集，但速度极慢。原始数据由 100,000+ 个数据点组成，超过 10 分钟后该函数无法执行

任何人都可以帮助我避免循环以使其更快吗？

标签： rfor-looptimestamptime-seriesxts

解决方案

创建一个函数Fillin，如果长度小于或等于 3，则返回 NA（如果第一个元素不是 NA，则返回 2，以便我们可以处理第一个组，即使它不以 NA 开头），否则返回其参数。用于cumsum对运行进行分组并应用于Fillin每个组。 

Fillin <- function(x) if (length(x) <= 3 - !is.na(x[1])) NA else x
Rc <- coredata(R)
R[] <- ave(Rc, cumsum(is.na(Rc)), FUN = Fillin)

给予：

> R
                       R-factor
2019-03-18 10:30:00          NA
2019-03-18 10:31:00          NA
2019-03-18 10:32:00          NA
2019-03-18 10:33:00          NA
2019-03-18 10:34:00          NA
2019-03-18 10:35:00          NA
2019-03-18 10:36:00 -0.50534386
2019-03-18 10:37:00 -0.09923439
2019-03-18 10:38:00  0.30535320
2019-03-18 10:39:00          NA

表现

该解决方案的运行速度与使用rle.

library(microbenchmark)

microbenchmark(
  Fill = { Fillin <- function(x) if (length(x) <= 3 - !is.na(x[1])) NA else x
    Rc <- coredata(R)
    R[] <- ave(Rc, cumsum(is.na(Rc)), FUN = Fillin)
  },
  RLrep = { rleR <-  rle(c(is.na(R[,1]))) 
    is.na(R) <- with(rleR,  rep(lengths < 3 , lengths ) )
  }
)

给予：

Unit: microseconds
  expr   min    lq    mean median     uq    max neval cld
  Fill 490.9 509.5 626.550  527.7 596.45 3411.1   100   a
 RLrep 523.5 540.8 604.061  550.8 592.00 1244.4   100   a

推荐阅读