Question

我正在平滑各种长度的时间序列。我的主要选择是使用函数smooth.spline()进行样条平滑，并为其提供参数nknots。 nknots参数基于序列的长度。但是，该函数可能无法拟合样条曲线，这很可能是因为结数太少，在这种情况下，我想使用滚动平均值代替。

我的问题如下：我试图将此操作嵌入到try()和tryCatch()调用中，但是对于这两种情况，我都无法摆脱（大量！）错误消息。

以下是我的tryCatch()尝试的示例代码：

Mysmooth.spline <- function(x, winlen, id){
  require(zoo)
  out <- tryCatch(
    {
      # Try to fit a cubic spline
      smooth.spline(x, nknots = round(length(x)/winlen))$y
    },
      # If this fails use rolling average padded with NAs
    error = function(e){
      print(paste("Spline replaced by rollmean for:  ", id))
      return(zoo::rollmean(x, winlen, fill = NA))
    },
    warning = function(w){}
  )
  return(out)
}

其中x是级数，id是标识符字符串，并且对确定样条线的结数和滚动平均值窗口的长度都保持倾斜。

这是一个可复制的玩具示例：

x_long  <- seq(1,100)
x_short <- seq(1,50)

# Returns the spline smoothed without error as expected
Mysmooth.spline(x_long, 25, "id_long")

# Returns the rolling average as expected but also prints many times an error
Mysmooth.spline(x_short, 25, "id_short")
# Returns many "spar-finding: non-finite value -nan; using BIG value" error
#[1] "Spline replaced by rollmean for:   id_short"

尽管结果是正确的，但我真的想摆脱这些烦人的错误，我们将不胜感激！

Answer 1

从现已删除的答案中得到一些启发，我想出了一个可行的解决方案：

Mysmooth.spline <- function(x, winlen, id){
  require(zoo)
  out <- tryCatch(
    {
      # Try to fit a cubic spline
      logger <- file("log.txt", open = "wt")
      sink(logger, type="message")
      smooth.spline(x, nknots = round(length(x)/winlen))$y
    },
    # If this fails use rolling average padded with NAs
    error = function(e){
      message(paste("Spline replaced by rollmean for:  ", id))
      return(zoo::rollmean(x, winlen, fill = NA))
    },
    warning = function(w){},
    finally = {
      sink(type = "message")
      close(logger)
    }
  )
  return(out)
}

此函数将所有错误消息返回到日志文件，而不是在控制台中打印它们。当数千次调用此函数时，这会大大提高速度，并且不会以红色消息污染控制台。请注意，我还使用message()报告有问题的系列的ID，这样它也将返回到日志文件。然后可以对该文件执行简单的模式提取以提取ID。

R，try或tryCatch，无错误日志

1 个答案: