我正在尝试建立一个简单的OLS模型,该模型对R中的系数有约束。下面的代码正在工作。但是,这证明了
y = c + a1x1 + a2x2 + a3x3,约束为a1 + a2 = 1
我想将此约束修改为: a1 * a2-a3 = 0
感谢您的帮助!
工作代码:
'''
set.seed(1000)
n <- 20
x1 <- seq(100,length.out=n)+rnorm(n,0,2)
x2 <- seq(50,length.out=n)+rnorm(n,0,2)
x3 <- seq(10,length.out=n)+rnorm(n,0,2)
constant <- 100
ymat <- constant + .5*x1 + .5*x2 + .75*x3 + rnorm(n,0,4)
xmat <- cbind(x1,x2,x3)
X <- cbind(rep(1,n),xmat) # explicitly include vector for constant
bh <- solve(t(X)%*%X)%*%t(X)%*%ymat
XX <- solve(t(X)%*%X)
cmat <- matrix(1,1,1)
Q <- matrix(c(0,1,1,0),ncol(X),1) # a1+a2=1 for y = c + a1x1 + a2x2 + a3x3
bc <- bh-XX%*%Q%*%solve(t(Q)%*%XX%*%Q)%*%(t(Q)%*%bh-cmat)
library(quadprog)
d <- t(ymat) %*% X
Rinv = solve(chol(t(X)%*%X))
qp <- solve.QP(Dmat=Rinv, dvec=d, Amat=Q, bvec=cmat, meq=1, factorized=TRUE)
qp
cbind(bh,qp$unconstrained.solution)
cbind(bc,qp$solution)
'''
答案 0 :(得分:0)
假设问题是将||最小化ymat-X b ||服从b [2] * b [3] == b [4]的^ 2我们可以用b [4]代替,给出如下所示的无约束nls
问题。下面的b
是b的前三个元素,我们可以通过将下面b
的后两个元素相乘得到b [4]。不使用任何软件包。
fm <- nls(ymat ~ X %*% c(b, b[2] * b[3]), start = list(b = 0:2))
fm
给予:
Nonlinear regression model
model: ymat ~ X %*% c(b, b[2] * b[3])
data: parent.frame()
b1 b2 b3
76.9718 0.6275 0.7598
residual sum-of-squares: 204
Number of iterations to convergence: 4
Achieved convergence tolerance: 6.555e-06
计算b4
prod(coef(fm)[-1])
## [1] 0.476805
以类似的方式,可以将原始问题(以最小化同一目标但具有原始约束)简化为无约束问题,并使用nls
通过替换来解决:
nls(ymat ~ X %*% c(b[1], b[2], 1-b[2], b[3]), start = list(b = 0:2))
给予:
Nonlinear regression model
model: ymat ~ X %*% c(b[1], b[2], 1 - b[2], b[3])
data: parent.frame()
b1 b2 b3
105.3186 0.3931 0.7964
residual sum-of-squares: 222.3
Number of iterations to convergence: 1
Achieved convergence tolerance: 4.838e-08
甚至可以重新设置参数,以使lm
可以解决这个原始问题
lm(ymat ~ I(X[, 2] - X[, 3]) + X[, 4] + offset(X[, 3]))
给予
Call:
lm(formula = ymat ~ I(X[, 2] - X[, 3]) + X[, 4] + offset(X[, 3]))
Coefficients:
(Intercept) I(X[, 2] - X[, 3]) X[, 4]
105.3186 0.3931 0.7964
答案 1 :(得分:0)
G。 grothendieck-谢谢您的回复。不幸的是,这对我没有用。
我决定进行长距离拉格朗日训练,结果太复杂了,我无法解决。
然后意识到,
a1*a2-a3 =0
a1*a2 = a3
ln(a1*a2)= ln(a3)
ln(a1) + ln(a2) -ln(a3) = 0
这给我留下了一个加性约束,我可以使用quadprog程序包解决该问题。
答案 2 :(得分:0)
也许您可以使用fmincon()
library(pracma)
library(NlcOptim)
# define objective function
fn <- function(v) norm(ymat- as.vector( xmat %*% v),"2")
# the constraint a1*a2 - a3 = 0
heq1 = function(v) prod(v[1:2])-v[3]
# solve a1, a2 and a3
res <- fmincon(0:2,fn,heq = heq1)
这样
> res$par
[1] 1.9043754 -0.1781830 -0.3393272