我希望找到4个变量的标量函数的局部最小值,并且我对变量有“范围约束”(“框约束”)。函数导数没有封闭形式,因此需要分析导数函数的方法是不可能的。我用optim
函数尝试了几个选项和控制参数,但所有这些参数看起来都很慢。具体来说,他们似乎在调用我的(R定义的)目标函数之间花了很多时间,所以我知道瓶颈不是我的目标函数,而是调用我的目标函数之间的“思考”。我查看了CRAN任务视图以进行优化,并尝试了其中几个选项(DEOptim
来自RcppDE
等),但它们似乎都没有任何好处。我本来想尝试nloptr
包(NLOPT库的R包装器),但它似乎不适用于Windows。
我想知道,是否存在人们使用的任何好的,快速的优化包我可能会丢失?理想情况下,这些将是围绕优秀的C ++ / Fortran库的薄包装形式,因此最小的纯R代码。 (虽然这不应该是相关的,但是在尝试通过最小化某个拟合优度度量来将4参数分布拟合到一组值时,我的优化问题出现了。)
过去我发现R的优化库非常慢,最后编写了一个瘦R包装器来调用商业优化库的C ++ API。那么最好的图书馆必然是商业图书馆吗?
UPDATE。以下是我正在查看的代码的简化示例:
###########
## given a set of values x and a cdf, calculate a measure of "misfit":
## smaller value is better fit
## x is assumed sorted in non-decr order;
Misfit <- function(x, cdf) {
nevals <<- nevals + 1
thinkSecs <<- thinkSecs + ( Sys.time() - snapTime)
cat('S')
if(nevals %% 20 == 0) cat('\n')
L <- length(x)
cdf_x <- pmax(0.0001, pmin(0.9999, cdf(x)))
measure <- -L - (1/L) * sum( (2 * (1:L)-1 )* ( log( cdf_x ) + log( 1 - rev(cdf_x))))
snapTime <<- Sys.time()
cat('E')
return(measure)
}
## Given 3 parameters nu (degrees of freedom, or shape),
## sigma (dispersion), gamma (skewness),
## returns the corresponding 4-parameter student-T cdf parametrized by these params
## (we restrict the location parameter mu to be 0).
skewtGen <- function( p ) {
require(ghyp)
pars = student.t( nu = p[1], mu = 0, sigma = p[2], gamma = p[3] )
function(z) pghyp(z, pars)
}
## Fit using optim() and BFGS method
fit_BFGS <- function(x, init = c()) {
x <- sort(x)
nevals <<- 0
objFun <- function(par) Misfit(x, skewtGen(par))
snapTime <<- Sys.time() ## global time snap shot
thinkSecs <<- 0 ## secs spent "thinking" between objFun calls
tUser <- system.time(
res <- optim(init, objFun,
lower = c(2.1, 0.1, -1), upper = c(15, 2, 1),
method = 'L-BFGS-B',
control = list(trace=2, factr = 1e12, pgtol = .01 )) )[1]
cat('Total time = ', tUser,
' secs, ObjFun Time Pct = ', 100*(1 - thinkSecs/tUser), '\n')
cat('results:\n')
print(res$par)
}
fit_DE <- function(x) {
x <- sort(x)
nevals <<- 0
objFun <- function(par) Misfit(x, skewtGen(par))
snapTime <<- Sys.time() ## global time snap shot
thinkSecs <<- 0 ## secs spent "thinking" between objFun calls
require(RcppDE)
tUser <- system.time(
res <- DEoptim(objFun,
lower = c(2.1, 0.1, -1),
upper = c(15, 2, 1) )) [1]
cat('Total time = ', tUser,
' secs, ObjFun Time Pct = ', 100*(1 - thinkSecs/tUser), '\n')
cat('results:\n')
print(res$par)
}
让我们生成一个随机样本:
set.seed(1)
# generate 1000 standard-student-T points with nu = 4 (degrees of freedom)
x <- rt(1000,4)
首先使用fit.tuv
包中的ghyp
(用于“T UniVariate”)函数进行拟合 - 这使用最大似然期望最大化(E-M)方法。这很快就邪恶!
require(ghyp)
> system.time( print(unlist( pars <- coef( fit.tuv(x, silent = TRUE) ))[c(2,4,5,6)]))
nu mu sigma gamma
3.16658356 0.11008948 1.56794166 -0.04734128
user system elapsed
0.27 0.00 0.27
现在我试图以不同的方式拟合分布:通过最小化上面定义的“错配”度量,使用基数R中的标准optim()
函数。请注意,结果通常不会相同。我这样做的原因是将这两个结果与一整类情况进行比较。我将上述最大似然估计值作为此优化的起点。
> fit_BFGS( x, init = c(pars$nu, pars$sigma, pars$gamma) )
N = 3, M = 5 machine precision = 2.22045e-16
....................
....................
.........
iterations 5
function evaluations 7
segments explored during Cauchy searches 7
BFGS updates skipped 0
active bounds at final generalized Cauchy point 0
norm of the final projected gradient 0.0492174
final function value 0.368136
final value 0.368136
converged
Total time = 41.02 secs, ObjFun Time Pct = 99.77084
results:
[1] 3.2389296 1.5483393 0.1161706
我也尝试适应DEoptim()
,但是它跑得太久了,我不得不杀了它。从上面的输出可以看出,99.8%的时间可归因于目标函数!所以Dirk和Mike在下面的评论中是正确的。我应该更仔细地估计在我的目标函数中花费的时间,打印点不是一个好主意!另外我怀疑MLE(E-M)方法非常快,因为它使用分析(闭合形式)作为对数似然函数。
答案 0 :(得分:10)
当您的问题存在时,最大似然估计值总是比任何语言的全局优化器都快。
全局优化器,无论算法如何,通常将一些随机跳转与局部最小化例程组合在一起。不同的算法可以用种群(遗传算法),退火,迁移等来讨论这个问题,但它们在概念上都是相似的。
实际上,这意味着如果你有一个平滑的功能,其他一些优化算法可能会最快。问题函数的特征将决定是否存在二次,线性,圆锥形或其他类型的优化问题,其中存在精确(或接近精确)的解析解,或者是否需要应用全局优化器这一定是慢的。
通过使用 ghyp ,你说你的4变量函数产生的输出可能适合广义双曲分布,并且你使用最大似然估计来找到最接近的广义双曲线分发您提供的数据。但如果你这样做,恐怕我不明白你怎么会有一个不光滑的表面需要优化。
通常,您选择的优化程序需要根据您的问题进行选择。在任何编程语言中都没有完美的“最优优化器”,并且选择适合您的问题的优化算法可能会比实现的任何轻微低效率产生更大的差异。