如何执行自动优化

Question

可以在此处找到示例数据。没办法，只能把数据放到网上，因为我无法生成有代表性的数据，

这是代码

myfunction <- function(df, parametr1, paramter2){
  do the stuff you want to do
}

我在这个函数中有两个参数需要优化

Answer 1

在开始回答的主要部分之前，先澄清一下：在问题中，您说要最小化“拟合残差（输入信号和平滑信号之间的差异）”。最小化残差之和几乎从来没有意义，因为这个和可能是负数 - 因此，尝试最小化这个函数将导致可以找到的最大负残差和（通常甚至不会收敛，因为残差可以变得无限负）。几乎总是做的是最小化残差的平方和，这就是我在这里所做的。

让我们从一个返回残差平方和的支付函数开始

payoff <- function(fl, forder) {
  M <- sav.gol(df[,1], fl = fl, forder = forder)
  resid2 <- (M-df[,1])^2
  sum(resid2)
}

请注意，我没有将 df 作为参数传递给此函数，而只是从父范围访问它。这是为了避免每次调用函数时不必要地复制数据帧，以减少内存和时间开销。

现在进入主要问题，对于整数值 1

这里的主要困难是优化参数fl和forder是整数。大多数典型的优化方法（例如那些由 optimize、optim 或 nlm 使用的方法）都是为连续参数的连续函数而设计的。离散优化完全是另一回事，其方法包括遗传算法等方法。例如，有关整数或离散优化的一些方法，请参阅这些 SO 帖子 here 和 here。

对于离散优化没有完美的解决方案，尤其是当您正在寻找全局最小值而不是局部最小值时。在您的情况下，残差平方和（收益）函数的表现不是很好并且会振荡。所以我们真的应该寻找一个全局最小值，而不是可能有很多的局部最小值。找到全局最小值的唯一确定方法是通过蛮力，实际上我们可以在这里采用这种方法，因为蛮力解决方案可以在合理的时间长度内计算。以下代码将计算 fl 和 forder 的所有值下的收益（目标）函数：

resord2 <- sapply(1:NROW(df),  FUN= function(x) payoff(x, 2))
resord4 <- sapply(1:NROW(df),  FUN= function(x) payoff(x, 4))

计算这些函数的时间仅随数据行数线性增加。使用你的 43k 行，这在我不是特别快的笔记本电脑上大约需要一天半的时间。

不过，幸运的是，我们不需要投入那么多计算时间。下图显示了 forder=2（蓝线）和 forder=4（红线）的残差平方和，fl up 为 40。

resord2 <- sapply(1:40,  FUN= function(x) payoff(x, 2))
resord4 <- sapply(1:40,  FUN= function(x) payoff(x, 4))
plot(1:40, resord2, log="y", type="l", col="blue", xlab="dl", ylab="residual sum of squares")
lines(1:40, resord4, col="red")

很明显，fl 的高值会导致高残差平方和。因此我们可以将优化搜索限制在 dl

resord2 <- sapply(1:40,  FUN= function(x) payoff(x, 2))
resord4 <- sapply(1:40,  FUN= function(x) payoff(x, 4))
which.min(resord2)
# 3
which.min(resord4)
# 3

如果我们想说服自己残差平方和确实会在更大范围内随着 fl 的增加而增加，我们可以使用更大范围的值来创建快速现实检查，让 fl 以更大的步长递增：

low_fl <- 10
high_fl <- 100
step_size <- 10
fl <- seq(low_fl, high_fl, by=step_size)
resord2 <- sapply(fl,  FUN= function(x) payoff(x, 2))
plot(fl, resord2)

Answer 2

如果我对您的理解正确，您希望尽量减少 T2 和您的输入 T 之间的差异。

首先，编辑sav.gol，使最后一行是return(T2)（我认为这不是必需的，但似乎是这样）。

以下内容不会给你我认为你想要的答案，因为它会选择接近 0 的过滤，但这是找到最小值的有效方法。

# make your residual function
resid <- function(fl, T, fo){
  fl <- round(fl)
  T2 <- sav.gol(T, fl, forder = fo, dorder = 0)
  sum((T2 - T) ^ 2)
}

# optimize for order 2
results_2 <- optimize(f = resid, interval = c(1, length(df[, 1])),
                      T = df[, 1], fo = 2)

# optimize for order 4
results_4 <- optimize(f = resid, interval = c(1, length(df[, 1])),
                      T=df[, 1], fo = 4)

编辑：

随着fl 的增加（最多 10k），我绘制了订单 2 的残差值； optimize 似乎找到了第一个局部最小值，可能需要一些调整。我建议您在答案中为您的过滤级别指定一些下限和上限。然后，您可以使用具有不同间隔的optimize。

library(ggplot)
resids <- sapply(1:10000, resid, T = df[1:10000, 1], fo = 2)
qplot(seq_along(resids), resids / 10^10,
      xlab = 'fl', ylab = 'Residual', geom='line')

顺便说一下，上面的sapply 可以替代optimize。你可以在完整的数据集上运行它，

resids <- sapply(1:length(df[,1], resid, T = df[, 1], fo = 2) 

在我的笔记本电脑上看起来需要大约 10 个小时，但是一旦完成，您可以按照上面的方法绘制它并通过眼睛选择过滤级别（或执行which.min(resids[lb:ub])，其中lb 和ub 是您的较低级别和上限）。