r - 带约束的 NLS 优化:曲线下面积相等
问题描述
我有一条中间有扰动的曲线(在 t=9 处),这导致我的数据出现下降(t<9)和上升(t>9)。我想拟合一个指数函数并添加一个约束,即两者(下降和上升)的面积相等。
见图:
我可以使用 optim 拟合曲线,但我无法弄清楚约束。这应该是这样的:
我已经尝试过 constrOptim,但我也愿意使用其他求解器。
y <-c(170, 160, 145, 127, 117, 74, 76, 78, 101, 115, 120, 70, 64, 65)
t <- seq(1,14,1)
# starting values:
lm <-lm(log(y) ~ log(t))
# Exp. Least-Squares minimization:
func <-function(pars) {
a <- pars["a"]
b <- pars["b"]
fitted <- a*exp(b*t)
sum((y-fitted)^2)
}
a <-lm$coefficients[[1]]
b <-lm$coefficients[[2]]
c <-
result <- optim(c(a=a, b=b), func)
# final parameters:
a <- result$par["a"]
b <- result$par["b"]
# predict values:
pred <- a*exp(b*t)
dat = data.frame(y=y, t=t, pred=pred)
library(ggplot2)
ggplot(dat, aes(x=t, y=y)) +
geom_line() +
geom_line(data=dat, aes(x=t, y=pred), color='blue')
编辑:
我知道我需要将约束添加到上面的优化中。像这样:
i = 6:12
result <- optim(c(a=a, b=b), func, sum(y[i]-a*exp(b*t[i])=0)
但这似乎不起作用。optim 函数不允许这种约束。
解决方案
我可以建议将干扰建模为正弦波吗?
fit <- nls(y ~ a * exp(b * t) + ifelse(d*(t - m) < 0 | d*(t - m) > 2 * pi, 0 , c * sin(d*(t - m))),
start = list(a = 170, b = -0.1, c = -20, d = 1, m = 5))
summary(fit)
dat <- data.frame(y=y, t=t)
preddat <- data.frame(t = seq(min(t), max(t), length.out = 100))
preddat$y <- predict(fit, preddat)
preddat$y1 <- coef(fit)[["a"]] * exp(coef(fit)[["b"]] * preddat$t)
library(ggplot2)
ggplot(dat, aes(x=t, y=y)) +
geom_line() +
geom_line(data=preddat, color='blue') +
geom_line(data=preddat, aes(y = y1), color='red', linetype = 2)
我敢肯定,具有信号处理背景的人可能会想出比丑陋的ifelse
黑客更好的东西。
推荐阅读
- powershell - Can't connect to vmware cluster with powershell
- python-3.x - ImportError:没有名为“onnx_backend”的模块?
- reactjs - 是否可以在图形区域添加两种颜色或在点中有两种颜色?
- sql - 将复杂性封装在表变量中是最佳实践吗?
- php - 如何使用循环在php中打印5个不同的变量(不使用ARRAY)
- jax-ws - 如何在 wildfly 10 中隔离战争类加载。获取 org.apache.cxf.enpoint.Client 类的可见性问题
- asp.net-mvc - 对多个视图、模型和控制器使用局部视图
- javascript - 从变量中设置动态 javascript 函数名称
- html-table - HTML表格中2行之间的空白
- git - Git - 如何添加 gitignore 文件