Question

我有一个复杂的组合模型，我可以在函数中定义一个可能性，我需要优化参数。问题是，如果没有限制，参数会全方向。因此，我需要对参数实施限制，教授提出的参数值的平方和应该等于1.

我一直在玩optim()和nlm()功能，但我无法得到我想要的东西。第一个想法是使用n-1参数并计算其余参数，但这不起作用（如预期的那样）。

为了说明，一些玩具数据和功能反映了我想要实现的核心问题：

dd <- data.frame(
    X1=rnorm(100),
    X2=rnorm(100),
    X3=rnorm(100)
)
dd <- within(dd,Y <- 2+0.57*X1-0.57*X2+0.57*X3+rnorm(100,0,0.2))

myfunc2 <- function(alpha,dd){
    alpha <- c(alpha,sqrt(1-sum(alpha^2)))
    X <- as.matrix(dd[,-4]) %*% alpha
    m.mat <- model.matrix(~X)
    mod <- glm.fit(m.mat,dd$Y)
    Sq <- sum(resid(mod)^2)
    return(Sq)
}

b <- c(1,0)
optim(b,myfunc2,dd=dd)

这显然导致：

Error: (subscript) logical subscript too long
In addition: Warning message:
In sqrt(1 - sum(alpha^2)) : NaNs produced

有人知道如何在优化过程中实现对参数的限制吗？

PS：我知道这个示例代码根本没有意义。它仅用于演示目的。

编辑：解决了！ - 见Mareks的答案。

Answer 1

我认为Ramnath answer并不坏，但他犯了一些错误。应该修改alpha修正。

这是改进版本：

myfunc2 <- function(alpha,dd){
    alpha <- alpha/sqrt(sum(alpha^2)) # here the modification ;)
    X <- as.matrix(dd[,-4]) %*% alpha
    m.mat <- model.matrix(~X)
    mod <- glm.fit(m.mat,dd$Y)
    Sq <- sum(resid(mod)^2)
    return(Sq)
}

b = c(1,1,1)
( x <- optim(b, myfunc2, dd=dd)$par )
( final_par <- x/sqrt(sum(x^2)) )

我的版本与你的无限制版本相似。

<强> [编辑]

如果起点错误，这将无法正常工作。 E.g

x <- optim(-c(1,1,1), myfunc2, dd=dd)$par
( final_par <- x/sqrt(sum(x^2)) )
# [1] -0.5925  0.5620 -0.5771

它否定了真实估计值，因为mod <- glm.fit(m.mat,dd$Y)估算了X的负系数。

我认为这次重新估计并不完全正确。我认为您应该将截距估计为残差的平均值Y-X*alpha。

类似的东西：

f_err_1 <- function(alpha,dd) {
    alpha <- alpha/sqrt(sum(alpha^2))
    X <- as.matrix(dd[,-4]) %*% alpha
    a0 <- mean(dd$Y-X)
    Sq <- sum((dd$Y-a0-X)^2)
    return(Sq)
}

x <- optim(c(1,1,1), f_err_1, dd=dd)$par;( final_par <- x/sqrt(sum(x^2)) )
# [1] 0.5924 -0.5620  0.5772
x <- optim(-c(1,1,1), f_err_1, dd=dd)$par;( final_par <- x/sqrt(sum(x^2)) )
# [1]  0.5924 -0.5621  0.5772

Answer 2

您需要提供有关约束的更多详细信息。如果你正在处理等于1的平方和，那么使用optim来解决它的优雅方法是让参数输入optim不受约束，并在优化函数中重新参数化。

为了说明我的观点，在上面说明的示例中，您可以通过对代码进行以下更改来运行优化：

myfunc2 <- function(alpha,dd){
    alpha <- alpha^2/sum(alpha^2);
    X <- as.matrix(dd[,-4]) %*% alpha
    m.mat <- model.matrix(~X)
    mod <- glm.fit(m.mat,dd$Y)
    Sq <- sum(resid(mod)^2)
    return(Sq)
}

b = c(1,1,1)
optim(b,myfunc2,dd=dd);
ans = b^2/sum(b^2)

这也适用于3个以上的变量。让我知道这是否有意义，如果你有其他问题。

Answer 3

它可能比你想要的要复杂一点，我现在没有时间弄清楚细节，但我认为你仍然可以做到这一点。假设您将所有参数绑定在0和1之间（您可以使用L-BFGS-B执行此操作）并将optim（）参数p和您的实际参数p'映射如下：

p_1' = p_1
p_2' = sqrt(p_2*(1-p_1'^2))
p_3' = sqrt(p_3*(1-(p_1^2+p_2^2))
...
p_n' = 1-sqrt(sum(p_i^2))

或类似的东西。

R中自定义函数的受限优化

3 个答案: