Question

可在此处找到示例数据。我别无选择，只能将数据放到网上，因为iI无法生成代表性数据，

这是代码

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＆lt; fl＆lt; NROW（df）和c（2,4）中的forder？

这里的主要困难是优化参数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的值为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＆lt; max.dl.这里我使用的max.dl为40。

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 1}}分别是你的下限和上限。

如何执行自动优化

2 个答案:

编辑：