我想找到以下目标函数的所有局部最小值
func <- function(b){Mat=matrix(c(+0.5*1/((1/(exp(-b[1]-b[2]*-5)+1))*(1-(1/(exp(-b[1]-b[2]*-5)+1))))*exp(-b[1] - b[2] * -5)/(exp(-b[1] - b[2] * -5) + 1)^2*exp(-b[1] - b[2] * -5)/(exp(-b[1] - b[2] * -5) + 1)^2+0.5*1/((1/(exp(-b[1]-b[2]*5)+1))*(1-(1/(exp(-b[1]-b[2]*5)+1))))*exp(-b[1] - b[2] * 5)/(exp(-b[1] - b[2] * 5) + 1)^2*exp(-b[1] - b[2] * 5)/(exp(-b[1] - b[2] * 5) + 1)^2,+0.5*1/((1/(exp(-b[1]-b[2]*-5)+1))*(1-(1/(exp(-b[1]-b[2]*-5)+1))))*exp(-b[1] - b[2] * -5) * -5/(exp(-b[1] - b[2] * -5) + 1)^2*exp(-b[1] - b[2] * -5)/(exp(-b[1] - b[2] * -5) + 1)^2+0.5*1/((1/(exp(-b[1]-b[2]*5)+1))*(1-(1/(exp(-b[1]-b[2]*5)+1))))*exp(-b[1] - b[2] * 5) * 5/(exp(-b[1] - b[2] * 5) + 1)^2*exp(-b[1] - b[2] * 5)/(exp(-b[1] - b[2] * 5) + 1)^2,+0.5*1/((1/(exp(-b[1]-b[2]*-5)+1))*(1-(1/(exp(-b[1]-b[2]*-5)+1))))*exp(-b[1] - b[2] * -5)/(exp(-b[1] - b[2] * -5) + 1)^2*exp(-b[1] - b[2] * -5) * -5/(exp(-b[1] - b[2] * -5) + 1)^2+0.5*1/((1/(exp(-b[1]-b[2]*5)+1))*(1-(1/(exp(-b[1]-b[2]*5)+1))))*exp(-b[1] - b[2] * 5)/(exp(-b[1] - b[2] * 5) + 1)^2*exp(-b[1] - b[2] * 5) * 5/(exp(-b[1] - b[2] * 5) + 1)^2,+0.5*1/((1/(exp(-b[1]-b[2]*-5)+1))*(1-(1/(exp(-b[1]-b[2]*-5)+1))))*exp(-b[1] - b[2] * -5) * -5/(exp(-b[1] - b[2] * -5) + 1)^2*exp(-b[1] - b[2] * -5) * -5/(exp(-b[1] - b[2] * -5) + 1)^2+0.5*1/((1/(exp(-b[1]-b[2]*5)+1))*(1-(1/(exp(-b[1]-b[2]*5)+1))))*exp(-b[1] - b[2] * 5) * 5/(exp(-b[1] - b[2] * 5) + 1)^2*exp(-b[1] - b[2] * 5) * 5/(exp(-b[1] - b[2] * 5) + 1)^2),2,2);d=(det(Mat));return(d)}
'func'是Logistic回归模型的Fisher信息矩阵的决定因素,是一个 参数b1和b2的函数,其中b1属于[-.3,.3],b2属于[6,8]
假设b = c(b1,b2)的这两个初始值
> in1 <- c(-0.04785405, 6.42711047)
> in2 <- c(0.2246729, 7.5211575)
初始值为in1
的本地最小值为:
> optim(in1, fn = func, lower = c(-.3, 6), upper = c(.3, 8), method = "L-BFGS-B")
$par
[1] -0.04785405 6.42711047
$value
[1] 3.07185e-27
$counts
function gradient
1 1
$convergence
[1] 52
$message
[1] "ERROR: ABNORMAL_TERMINATION_IN_LNSRCH"
从$massage
中可以看出,优化过程中发生了终止,无法计算最小值,optim
作为本地最优值返回in1
。
对于'in2',也会出现错误:
> optim(in2, fn = func, lower = c(-.3, 6), upper = c(.3, 8), method = "L-BFGS-B")
Error in optim(in2, fn = func, lower = c(-0.3, 6), upper = c(0.3, 8), :
L-BFGS-B needs finite values of 'fn'
发生此错误是因为func
NaN` in2' is
的值:
> func(in2)
[1] NaN
但是对于in1
,会计算in1
处目标函数的值,但优化会终止,因为optim
无法继续计算另一个
初始值:
> func(in1)
[1] 3.07185e-27
让我定义func而不是det,只是作为矩阵来看看发生了什么:
Mat.func <- function(b){Mat=matrix(c(+0.5*1/((1/(exp(-b[1]-b[2]*-5)+1))*(1-(1/(exp(-b[1]-b[2]*-5)+1))))*exp(-b[1] - b[2] * -5)/(exp(-b[1] - b[2] * -5) + 1)^2*exp(-b[1] - b[2] * -5)/(exp(-b[1] - b[2] * -5) + 1)^2+0.5*1/((1/(exp(-b[1]-b[2]*5)+1))*(1-(1/(exp(-b[1]-b[2]*5)+1))))*exp(-b[1] - b[2] * 5)/(exp(-b[1] - b[2] * 5) + 1)^2*exp(-b[1] - b[2] * 5)/(exp(-b[1] - b[2] * 5) + 1)^2,+0.5*1/((1/(exp(-b[1]-b[2]*-5)+1))*(1-(1/(exp(-b[1]-b[2]*-5)+1))))*exp(-b[1] - b[2] * -5) * -5/(exp(-b[1] - b[2] * -5) + 1)^2*exp(-b[1] - b[2] * -5)/(exp(-b[1] - b[2] * -5) + 1)^2+0.5*1/((1/(exp(-b[1]-b[2]*5)+1))*(1-(1/(exp(-b[1]-b[2]*5)+1))))*exp(-b[1] - b[2] * 5) * 5/(exp(-b[1] - b[2] * 5) + 1)^2*exp(-b[1] - b[2] * 5)/(exp(-b[1] - b[2] * 5) + 1)^2,+0.5*1/((1/(exp(-b[1]-b[2]*-5)+1))*(1-(1/(exp(-b[1]-b[2]*-5)+1))))*exp(-b[1] - b[2] * -5)/(exp(-b[1] - b[2] * -5) + 1)^2*exp(-b[1] - b[2] * -5) * -5/(exp(-b[1] - b[2] * -5) + 1)^2+0.5*1/((1/(exp(-b[1]-b[2]*5)+1))*(1-(1/(exp(-b[1]-b[2]*5)+1))))*exp(-b[1] - b[2] * 5)/(exp(-b[1] - b[2] * 5) + 1)^2*exp(-b[1] - b[2] * 5) * 5/(exp(-b[1] - b[2] * 5) + 1)^2,+0.5*1/((1/(exp(-b[1]-b[2]*-5)+1))*(1-(1/(exp(-b[1]-b[2]*-5)+1))))*exp(-b[1] - b[2] * -5) * -5/(exp(-b[1] - b[2] * -5) + 1)^2*exp(-b[1] - b[2] * -5) * -5/(exp(-b[1] - b[2] * -5) + 1)^2+0.5*1/((1/(exp(-b[1]-b[2]*5)+1))*(1-(1/(exp(-b[1]-b[2]*5)+1))))*exp(-b[1] - b[2] * 5) * 5/(exp(-b[1] - b[2] * 5) + 1)^2*exp(-b[1] - b[2] * 5) * 5/(exp(-b[1] - b[2] * 5) + 1)^2),2,2);d=Mat;return(d)}
我们得到了
> Mat.func(in1)
[,1] [,2]
[1,] 1.109883e-14 2.784007e-15
[2,] 2.784007e-15 2.774708e-13
> Mat.func(in2)
[,1] [,2]
[1,] Inf Inf
[2,] Inf Inf
因此,通过双精度,Mat.func(in2)
元素的值为Inf
。
我还用mpfr函数重写了Mat.func
:
Mat.func.mpfr <-function(b, prec){ d=c(+0.5*1/((1/(exp(-mpfr(b[1], precBits = prec)-mpfr(b[2], precBits = prec)*-5)+1))*(1-(1/(exp(-mpfr(b[1], precBits = prec)-mpfr(b[2], precBits = prec)*-5)+1))))*exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * -5)/(exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * -5) + 1)^2*exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * -5)/(exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * -5) + 1)^2+0.5*1/((1/(exp(-mpfr(b[1], precBits = prec)-mpfr(b[2], precBits = prec)*5)+1))*(1-(1/(exp(-mpfr(b[1], precBits = prec)-mpfr(b[2], precBits = prec)*5)+1))))*exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * 5)/(exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * 5) + 1)^2*exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * 5)/(exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * 5) + 1)^2,
+0.5*1/((1/(exp(-mpfr(b[1], precBits = prec)-mpfr(b[2], precBits = prec)*-5)+1))*(1-(1/(exp(-mpfr(b[1], precBits = prec)-mpfr(b[2], precBits = prec)*-5)+1))))*exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * -5) * -5/(exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * -5) + 1)^2*exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * -5)/(exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * -5) + 1)^2+0.5*1/((1/(exp(-mpfr(b[1], precBits = prec)-mpfr(b[2], precBits = prec)*5)+1))*(1-(1/(exp(-mpfr(b[1], precBits = prec)-mpfr(b[2], precBits = prec)*5)+1))))*exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * 5) * 5/(exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * 5) + 1)^2*exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * 5)/(exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * 5) + 1)^2,
+0.5*1/((1/(exp(-mpfr(b[1], precBits = prec)-mpfr(b[2], precBits = prec)*-5)+1))*(1-(1/(exp(-mpfr(b[1], precBits = prec)-mpfr(b[2], precBits = prec)*-5)+1))))*exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * -5)/(exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * -5) + 1)^2*exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * -5) * -5/(exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * -5) + 1)^2+0.5*1/((1/(exp(-mpfr(b[1], precBits = prec)-mpfr(b[2], precBits = prec)*5)+1))*(1-(1/(exp(-mpfr(b[1], precBits = prec)-mpfr(b[2], precBits = prec)*5)+1))))*exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * 5)/(exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * 5) + 1)^2*exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * 5) * 5/(exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * 5) + 1)^2,
+0.5*1/((1/(exp(-mpfr(b[1], precBits = prec)-mpfr(b[2], precBits = prec)*-5)+1))*(1-(1/(exp(-mpfr(b[1], precBits = prec)-mpfr(b[2], precBits = prec)*-5)+1))))*exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * -5) * -5/(exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * -5) + 1)^2*exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * -5) * -5/(exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * -5) + 1)^2+0.5*1/((1/(exp(-mpfr(b[1], precBits = prec)-mpfr(b[2], precBits = prec)*5)+1))*(1-(1/(exp(-mpfr(b[1], precBits = prec)-mpfr(b[2], precBits = prec)*5)+1))))*exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * 5) * 5/(exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * 5) + 1)^2*exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * 5) * 5/(exp(-mpfr(b[1], precBits = prec) - mpfr(b[2], precBits = prec) * 5) + 1)^2)
Mat = new("mpfrMatrix", d, Dim = c(2L, 2L))
return(Mat)}
因此:
require(Rmpfr)
> Mat.func.mpfr(c(in1), prec = 54)
'mpfrMatrix' of dim(.) = (2, 2) of precision 54 bits
[,1]
[1,] 1.10988301365972506e-14
[2,] 2.78400749725484580e-15
[,2]
[1,] 2.78400749725484580e-15
[2,] 2.77470753414931256e-13
> Mat.func.mpfr(c(in2), prec = 54)
'mpfrMatrix' of dim(.) = (2, 2) of precision 54 bits
[,1] [,2]
[1,] Inf Inf
[2,] Inf Inf
> Mat.func.mpfr(c(in2), prec = 55)
'mpfrMatrix' of dim(.) = (2, 2) of precision 55 bits
[,1]
[1,] 4.16032108702067276e-17
[2,] -8.34300174643550123e-17
[,2]
[1,] -8.34300174643550154e-17
[2,] 1.04008027175516816e-15
因此,通过精度55,矩阵元素的值不再是Inf
。不幸,
mpfr
函数更改了目标的类,det
也没有优化函数不能应用,澄清我提供了两个例子:
> class(mpfr (1/3, 54))
[1] "mpfr"
attr(,"package")
[1] "Rmpfr"
## determinant
example1 <- function(x){
d <- c(mpfr(x, prec = 54), 3 * mpfr(x, prec = 54), 5 * mpfr(x, prec = 54), 7 * mpfr(x, prec = 54))
Mat = new("mpfrMatrix", d, Dim = c(2L, 2L))
return(det(Mat))
}
> example1(2)
Error in UseMethod("determinant") :
no applicable method for 'determinant' applied to an object of class "c('mpfrMatrix', 'mpfrArray', 'Mnumber', 'mNumber', 'mpfr', 'list', 'vector')"
##optimization
example2 <- function(x) ## Rosenbrock Banana function
100 * (mpfr(x[2], prec = 54) - mpfr(x[1], prec = 54) * mpfr(x[1], prec = 54 ))^2 + (1 - mpfr(x[1], prec = 54))^2
> example2(c(-1.2, 1))
1 'mpfr' number of precision 54 bits
[1] 24.1999999999999957
> optim(c(-1.2,1), example2)
Error in optim(c(-1.2, 1), example2) :
(list) object cannot be coerced to type 'double'
因此,使用mpfr无法解决问题。
要查找所有局部最小值,应编写应用不同随机初始值的算法。
但是可以看出,对于一些初始值,函数产生NaN
(忽略这些值不是一个好主意,因为它通常会导致遗漏一些局部最小值,特别是对于具有大量局部最优值的函数)。
我想知道是否有任何R包可以进行任意精度的优化过程,以避免NaN
目标函数?
谢谢
答案 0 :(得分:4)
我认为 答案(我认为'agstudy'也给出了): 确保您最小化的函数 NOT 返回NaN(或NA),而不是+ Inf(如果您最小化,或者 - 如果你最大化了。)
第二:代替日志(det(。))你真的应该使用
{
r&lt; - determinant(。,log = TRUE);
if(r $ sign&lt; = 0)-Inf else r $ modulus
}
这也更准确。 {提示:看看如何在R中定义det!}
现在到Rmpfr,我会另外回复。 应像标准R一样使用“mpfr” - 数字, .... Rmpfr的作者说.... 但你可能需要一点关心。 但是,不应该需要tryCatch()。
答案 1 :(得分:3)
我试图重新制定你可怕的(抱歉)这个目标函数。我很确定我们可以找到更简单的形式。希望其他人可以使用它来找到优化问题的解决方案......
func1 <- function(b){
A <- exp(-b[1]+5*b[2])
C <- exp(-b[1]-5*b[2])
A1 <- A + 1
C1 <- C + 1
D <- 1/A1
H <- 1/C1
K <- D*(1-D)
J <- H*(1-H)
M <- (A/A1^2)^2/K
N <- (C/C1^2)^2/J
Mat <- matrix(c( 1 *M + 1 *N,
-5 *M + 5 *N,
-5 *M + 5 *N,
25 *M + 25 *N),2,2)
Mat <- 0.5*Mat
d <- log(det(Mat))
return(d)
}
修改强>
正如我所说,你可以再次简化你的功能。它看起来好多了
func1 <- function(b){
A <- exp(-b[1]+5*b[2])
C <- exp(-b[1]-5*b[2])
A1 <- A + 1
C1 <- C + 1
M <- A/A1^2
N <- C/C1^2
det.Mat <-25*M*N
log(det.Mat)
}
这里有两个功能之间的一些测试。
func1(c(1,2))
[1] -16.7814
> func1(c(8,2))
[1] -17.03498
> func1(c(10,2))
[1] -18.16742
> func(c(10,2))
[1] -18.16742
> func(c(10,5))
[1] -46.83608
重新制定最小化了下溢/溢出的可能性(不能将中间结果存储在寄存器中)..这就是为什么我们得到Inf而不是NA(见下文),这是无限但仍然是数字< / strong>,适合与NaN相对的更远的计算,就像NA值一样。
FUNC(C(10100))
[1] NaN func1的(C(10100)) [1] -Inf
现在我在更简单的表单上测试你的优化指令,它会收敛,如你所见:
in1 <- c(-0.04785405, 6.42711047)
in2 <- c(0.2246729, 7.5211575)
ll <- optim(in1, fn = func1, lower = c(-.3, 6), upper = c(.3, 8), method = "L-BFGS-B")
do.call(rbind,ll)
function gradient
par "-0.04785405" "8"
value "-76.7811241751318" "-76.7811241751318"
counts "2" "2"
convergence "0" "0"
message "CONVERGENCE: NORM OF PROJECTED GRADIENT <= PGTOL" "CONVERGENCE: NORM OF PROJECTED GRADIENT <= PGTOL"
in2
同样的事情optim(in2, fn = func1, lower = c(-.3, 6), upper = c(.3, 8), method = "L-BFGS-B")
$par
[1] 0.2246729 8.0000000
$value
[1] -76.78112
$counts
function gradient
2 2
$convergence
[1] 0
$message
[1] "CONVERGENCE: NORM OF PROJECTED GRADIENT <= PGTOL"
答案 2 :(得分:2)
使用Rmpfr
生成的矩阵回答您的问题:
(虽然不太有效......!...):
是的,determinant()不适用于mpfr-matrices, 然而你可以简单地使用像
这样的东西M <- Mat.func.mpfr(in2, prec = 55)
m <- as(M, "matrix")
ldm <- determinant(m) # is already log() !
然后使用
{ r <- determinant(., log=TRUE) ; if(r$sign <= 0) -Inf else r$modulus }
我上面已经提到了...比``设计错误''使用log(det(。))
更好的东西答案 3 :(得分:1)
对于arb精度:gmp
和/或Rmpfr
。
不过,在代码中使用tryCatch
可能会更好(尽管为了避免在给定的尝试导致NaN
错误时崩溃)
答案 4 :(得分:0)
使用mpfr
可以有效避免函数中的计算NaN
(并且还会停止优化算法)。但
mpfr
输出是'mpfr'类,并且某些R函数(例如optim
和det
)可能不适用于此类。
像往常一样as.numeric
可以应用于将'mpfr'类转换为'数字'类。
exp(9000)
[1] Inf
require(Rmpfr)
number <- as.numeric(exp(mpfr(9000, prec = 54)))
class(number)
[1] "numeric"
round(number)
[1] 1.797693e+308
number * 1.797692e-308
[1] 3.231699
number * 1.797693e-307
[1] 32.317
number * (1/number)
[1] 1
number * .2
[1] 3.595386e+307
number * .9
[1] 1.617924e+308
number * 1.1
[1] Inf
number * 2
[1] Inf
number / 2
[1] 8.988466e+307
number + 2
[1] 1.797693e+308
number + 2 * 10 ^ 291
[1] 1.797693e+308
number + 2 * 10 ^ 292
[1] Inf
number - 2
[1] 1.797693e+308
number - 2 * 10 ^ 307
[1] 1.597693e+308
number - 2 * 10 ^ 308
[1] -Inf
现在考虑以下矩阵函数:
mat <- function(x){
x1 <- x[1]
x2 <- x[2]
d = matrix(c(exp(5 * x1+ 4 * x2), exp(9 * x1), exp(2 * x2 + 4 * x1),
exp(3 * x1)), 2, 2)
return(d)
}
此矩阵的元素极有可能产生Inf
:
mat(c(300, 1))
[,1] [,2]
[1,] Inf Inf
[2,] Inf Inf
因此,如果在函数环境中返回det
,而不是数字结果,我们得到NaN
,optim
函数肯定会被终止。为解决此问题,此函数的决定因素由mpfr
:
func <- function (x){
x1 <- mpfr(x[1], prec = precision)
x2 <- mpfr(x[2], prec = precision)
mat <- new("mpfrMatrix",c(exp(5 * x1+ 4 * x2), exp(9 * x1), exp(2 * x2 + 4 * x1), exp(3 * x1)), Dim = c(2L,2L))
d <- mat[1, 1] * mat[2, 2] - mat[2, 1] * mat[1, 2]
return(as.numeric(-d))
}
然后对于x1 = 3和x2 = 1我们有:
func(c(3,1))
[1] 6.39842e+17
optim(c(3, 1),func)
$par
[1] 0.4500 1.4125
$value
[1] -4549.866
$counts
function gradient
13 NA
$convergence
[1] 0
$message
NULL
并且x1 = 300且x2 = 1:
func(c(300,1))
[1] 1.797693e+308
optim(c(300, 1),func)
$par
[1] 300 1
$value
[1] 1.797693e+308
$counts
function gradient
3 NA
$convergence
[1] 0
$message
NULL
可以看出,在优化过程中没有停止甚至optim
的约束。但是,似乎没有迭代,optim
只返回初始值作为局部最小值(当然,1.797693e + 308不是此函数的局部最小值!!)。
在这种情况下,应用mpfr
可以防止优化过程终止,
但是如果我们真的希望优化算法从这样的点开始,它们的值是Inf
R双精度并继续迭代达到局部最小值,除了用'mpfr'类定义一个函数,优化函数也应该具备使用'mpfr'类的能力。