修改常用的 hpfilter 函数以忽略 na's

Question

我是一个新的 R 用户，试图快速学习，但我自己无法破解这个问题。我主要处理经济时间序列 - 因此，尝试以 xts 多列格式维护我的数据集，例如：

> head(USDATAq)
         tq   ngdp    rgdp  profit
1947 Q1   0  237.2  1770.7    20.7
1947 Q2   1  240.4  1768.0    23.9
1947 Q3   2  244.5  1766.5    23.8
1947 Q4   3  254.3  1793.3    25.5
1948 Q1   4  260.3  1821.8    29.4
1948 Q2   5  267.3  1855.3    31.2

我应用 hpfilter 函数进行过滤。 在本网站的其他地方，我发现此实现使用 coredata 函数将 hpfilter 应用于 xts 对象：

hpfilter <- function(x, lambda=2){
  eye <- diag(length(x))
  dcrossprod <- crossprod(diff(eye, lag=1, d=2))
  coredata(x) <- solve(eye + lambda * dcrossprod, coredata(x))
  return(x)
}

我的问题是：

如何修改该函数，以便它将与具有以下变量的变量一起使用NA 观测值（目前，如果有 NA，它会计算整个日期范围的 NA）？

我可以将数据集作为 na.omit(USDATAq) 传递，这可以工作，但这会将数据集中的所有变量限制为最小观测值。但是，不同的变量在不同的日期之前可用，随后是 NA。我希望最终将该函数应用到循环或映射中的数据集的每一列，以便该函数使用该系列的所有可用观察结果返回每个过滤后的系列。

Answer 1

谢谢@ran2。我按照你的建议工作并设法解决了问题——但是，以一种相当不优雅的方式。首先，我无法让任何“apply family”函数在 xts 对象上正常工作，维持其结构。对于按列应用程序，使用 apply(x, MARGIN=2,..) 进行普通应用显示出希望，但在“coredata”语句处停滞。 lapply 等产生了损坏的列表。

然后我进入了for循环。但由于 x<-na.omit(x) 改变了变量的长度，因此它无法替换循环内的原始变量。

> for(i in 1:ncol(USDATAq)) {
+ USDATAq[,i]<-hpfilter(USDATAq[,i])
+ }

NextMethod(.Generic) 中的错误：
要替换的项目数量不是替换长度的倍数

因此，我不得不向 hpfilter 添加不合时宜的代码，以将结果“合并”回原始值（带有 NA），然后返回变量。此合并按日期（因此，长度）匹配 2 个变量，将 NA 填充到结果中。然后，这个结果可以在循环中替换原来的结果。总之，我必须将 hpfilter 修改为：

hpfilter <- function(x,lambda=2){
y<-na.omit(x)
eye <- diag(length(y))
coredata(y) <- solve(eye + lambda * crossprod(diff(eye, lag=1, d=2)), coredata(y))
xy<-merge(x,y) 
return(xy[,2])
}

然后使用上面的循环，最终获得无错误的结果。不过，我对 R 的了解还很初级，可能有更简单的方法可以做到这一点。但至少，我现在可以继续。感谢所有人为我指明了正确的方向。我仍然欢迎对上面的代码进行进一步更正。

Answer 2

我认为你走在正确的道路上。为什么不在这个函数中添加 na.omit 呢？就在创建眼睛矩阵之前？ x<-na.omit(x)。然后你所要做的就是将单变量系列传递给它而不是整个 data.frames。换句话说：保持函数不变，添加 na.omit 并将其与 lapply （或任何形式的 apply 系列（sapply、tapply、lapply）组合）你最好的。

Answer 3

对于动物园对象，使用 attributes() 而不是 coredata() 会稍微干净一些，然后您可以直接合并回动物园对象。 （我还没有对 xts 对象尝试过这个）：

hpfilter <- function(x,lambda=1600){
    y<-na.omit(x)
    eye <- diag(length(y))
    result <- solve(eye+lambda*crossprod(diff(eye,lag=1,d=2)),y)
    attributes(result) <- attributes(y)
    return(result)
}