Получение промежуточных результатов от nloptr в R

Question

Я запускаю пакет nloptr в R и у меня возникают проблемы с получением промежуточных результатов для алгоритма. Алгоритм работает отлично, но я не хочу просто окончательное решение и номер итерации, но, скорее, я хочу иметь возможность получить текущее значение функции возражения на каждой итерации. Вот код, я использую

library(tgp) 
library(nloptr) 

######################################################################################### 
### 
######################################################################################### 

f = function(x){ 
    ans = cos(pi*(x[1]+x[2]*x[3]+x[4]))+.2*sin(4*pi*(x[5]*x[6]+x[7])/(x[8]+1)) 
    return(ans) 
} 

const = function(x){ 
    ans = numeric(2) 
    ans[1] = sin(pi*(x[1]+x[2]*x[3]+x[4]))+.2*cos(4*pi*(x[5]*x[6]+x[7])/(x[8]+1)) 
    ans[2] = -cos(pi*(x[1]+x[2]*x[3]+x[4]))+.2*cos(4*pi*(x[5]*x[6]+x[7])/(x[8]+1)) 
    ans[1] = -ans[1] 
    ans[2] = -ans[2] 
    return(ans) 
} 

######################################################################################### 
### 
######################################################################################### 

lhs.size = 1 
lhs.lower = 0 
lhs.upper = 1 
x0 = c(lhs(lhs.size,rbind(c(lhs.lower,lhs.upper),c(lhs.lower,lhs.upper),c(lhs.lower,lhs.upper),c(lhs.lower,lhs.upper),c(lhs.lower,lhs.upper),c(lhs.lower,lhs.upper),c(lhs.lower,lhs.upper),c(lhs.lower,lhs.upper)))) 

COB = cobyla(x0,f,hin=const,lower=rep(0,8),upper=rep(1,8),nl.info = TRUE, control = list(xtol_rel = 1e-16, maxeval = 2000)) 

и так, что объект COB дает мне это:

> COB 
$par 
[1] 0.4209398 0.4932406 0.5175745 0.7786042 0.2980017 0.6785051 0.2313283 0.3872766 

$value 
[1] -0.2828427 

$iter 
[1] 559 

$convergence 
[1] 4 

$message 
[1] "NLOPT_XTOL_REACHED: Optimization stopped because xtol_rel or xtol_abs (above) was reached." 

Но я хочу $value$iteration для каждого.

Answer 1

Это одна из возможностей. По другому вопросу я определил набор функций reap/sow, которые позволяют собирать значения по разным вызовам функций. Если я определяю вспомогательную функцию под названием «сеятель»

sower <- function(f,n=deparse(substitute(f))) { 
    function(...) { 
     x <- f(...) 
     do.call("sow", setNames(list(x),n)) 
     x 
    } 
} 

который оборачивает функцию и собирает его вывод через sow(), я могу использовать, что с вызовом

rr <- reap(COB = cobyla(x0, sower(f), hin=sower(const), 
    lower=rep(0,8), upper=rep(1,8), nl.info = TRUE, 
    control = list(xtol_rel = 1e-16, maxeval = 2000))) 

Тогда вы можете получить стандартные возвращаемые значения все еще находятся в COB, но вы также можете позвонить

rr$f 
rr$const 

Чтобы получить значение функций каждый раз, когда они были названы. (Опять же, обязательно включите функции reap/sow, определенные в ответе на другую функцию.)

Answer 2

Мы можем проследить f, выпустив этот оператор в любое время перед запуском cobyla. Это приведет к отображению объектного значения, за которым следуют значения параметров, каждый раз, когда оценивается f.

trace(f, exit = quote(cat(returnValue(), x, "\n"))) 

Чтобы удалить след:

untrace(f) 

Вот демонстрация:

> f <- function(x) 2*x 
> trace(f, exit = quote(cat(returnValue(), x, "\n"))) 
[1] "f" 
> f(3) 
Tracing f(3) on exit 
6 3 
[1] 6 

> R.version.string 
[1] "R version 3.2.2 Patched (2015-10-19 r69550)" 

Кроме того, здесь последний бит выхода, когда я бегу COB (...) с заявлением в вопросе после проведения заявления trace:

Tracing f1(x, ...) on exit 
-0.7071068 0.9867454 0.9798806 0.9903225 0.7928568 0.9767687 0.6967606 0.6352815 0.05268439 
Tracing f1(x, ...) on exit 
-0.7071068 0.9867454 0.9798806 0.9903225 0.7928568 0.9767687 0.6967606 0.6352815 0.05268439 
Tracing f1(x, ...) on exit 
-0.7071068 0.9867454 0.9798806 0.9903225 0.7928568 0.9767687 0.6967606 0.6352815 0.05268439 
Tracing f1(x, ...) on exit 
-0.7071068 0.9867454 0.9798806 0.9903225 0.7928568 0.9767687 0.6967606 0.6352815 0.05268439 
Tracing f1(x, ...) on exit 
-0.7071068 0.9867454 0.9798806 0.9903225 0.7928568 0.9767687 0.6967606 0.6352815 0.05268439 

Call: 
nloptr(x0 = x0, eval_f = fn, lb = lower, ub = upper, eval_g_ineq = hin,  opts = opts) 


Minimization using NLopt version 2.4.0 

NLopt solver status: 5 (NLOPT_MAXEVAL_REACHED: Optimization stopped because maxeval (above) was reached.) 

Number of Iterations....: 2000 
Termination conditions: stopval: -Inf xtol_rel: 1e-16 maxeval: 2000 ftol_rel: 0  ftol_abs: 0 
Number of inequality constraints: 2 
Number of equality constraints: 0 
Current value of objective function: -0.707106791132674 
Current value of controls: 0.9867454 0.9798806 0.9903225 0.7928568 0.9767687 0.6967606 0.6352815 0.05268439 

Answer 3

Вы можете добавить «уровень печати = 3» в опционную часть кода. Например:

opts = list("algorithm"="NLOPT_LN_COBYLA", 
     "xtol_rel"=1.0e-8, "maxeval"= 5000, 
     "print_level" = 3) 

, а затем использовать opts при вызове алгоритма, то есть.

result <- nloptr(my.data.var,eval_f = Error.func, 
       lb=lb,ub=ub, 
       eval_g_ineq=constraint.func, 
       opts = opts) 

Это даст вам значение целевой функции отдельно от параметров на каждой итерации.