Ограничение модуля оптимизации Mathematica

У меня вопрос относительно возможностей глобальной оптимизации системы Mathematica. Я наткнулся на этот текст, связанный с набором инструментов NAG (своего рода белая книга) .

Теперь я попытался решить тестовый пример из статьи. Как и ожидалось, Mathematica довольно быстро решила эту проблему.

n=2;
fun[x_,y_]:=10 n+(x-2)^2-10Cos[2 Pi(x-2)]+(y-2)^2-10 Cos[2 Pi(y-2)];
NMinimize[{fun[x,y],-5<= x<= 5&&-5<= y<= 5},{x,y},Method->{"RandomSearch","SearchPoints"->13}]//AbsoluteTiming

Результатом было

{0.0470026,{0.,{x->2.,y->2.}}}

Можно увидеть точки, которые посещала процедура оптимизации.

{sol, pts}=Reap[NMinimize[{fun[x,y],-5<= x<= 5&&-5<= y<= 5},{x,y},Method->`{"RandomSearch","SearchPoints"->13},EvaluationMonitor:>Sow[{x,y}]]];Show[ContourPlot[fun[x,y],{x,-5.5,5.5},{y,-5.5,5.5},ColorFunction->"TemperatureMap",Contours->Function[{min,max},Range[min,max,5]],ContourLines->True,PlotRange-> All],ListPlot[pts,Frame-> True,Axes-> False,PlotRange-> All,PlotStyle-> Directive[Red,Opacity[.5],PointSize[Large]]],Graphics[Map[{Black,Opacity[.7],Arrowheads[.026],Arrow[#]}&,Partition[pts//First,2,1]],PlotRange-> {{-5.5,5.5},{-5.5,5.5}}]]`

Теперь я подумал о решении той же проблемы в более высокой размерности. Для задач с пятью переменными математика начала попадать в ловушку локального минимума, даже когда разрешено большое количество точек поиска.

n=5;funList[x_?ListQ]:=Block[{i,symval,rule},
i=Table[ToExpression["x$"<>ToString[j]],{j,1,n}];symval=10  n+Sum[(i[[k]]-2)^2-10Cos[2Pi(i[[k]]-2)],{k,1,n}];rule=MapThread[(#1-> #2)&,{i,x}];symval/.rule]val=Table[RandomReal[{-5,5}],{i,1,n}];vars=Table[ToExpression["x$"<>ToString[j]],{j,1,n}];cons=Table[-5<=ToExpression["x$"<>ToString[j]]<= 5,{j,1,n}]/.List-> And;NMinimize[{funList[vars],cons},vars,Method->{"RandomSearch","SearchPoints"->4013}]//AbsoluteTiming

Выходные данные были не тем, что мы хотели бы видеть. На моей машине core2duo потребовалось 49 секунд, и все же это локальный минимум.

{48.5157750,{1.98992,{x$1->2.,x$2->2.,x$3->2.,x$4->2.99496,x$5->1.00504}}}

Затем попробовал SimulatedAnealing с 100000 итераций.

NMinimize[{funList[vars],cons},vars,Method->"SimulatedAnnealing",MaxIterations->100000]//AbsoluteTiming

Результат все еще был неудовлетворительным.

{111.0733530,{0.994959,{x$1->2.,x$2->2.99496,x$3->2.,x$4->2.,x$5->2.}}}

Теперь в Mathematica есть точный алгоритм оптимизации под названием Minimize. Что, как и ожидалось, должно потерпеть неудачу с практической точки зрения, но оно терпит неудачу очень быстро, поскольку размер проблемы увеличивается.

n=3;funList[x_?ListQ]:=Block[{i,symval,rule},i=Table[ToExpression["x$"<>ToString[j]],{j,1,n}];symval=10 n+Sum[(i[[k]]-2)^2-10Cos[2 Pi(i[[k]]-2)],{k,1,n}];rule=MapThread[(#1-> #2)&,{i,x}];symval/.rule]val=Table[RandomReal[{-5,5}],{i,1,n}];vars=Table[ToExpression["x$"<>ToString[j]],{j,1,n}];cons=Table[-5<=ToExpression["x$"<>ToString[j]]<= 5,{j,1,n}]/.List-> And;Minimize[{funList[vars],cons},vars]//AbsoluteTiming

вывод в порядке.

{5.3593065,{0,{x$1->2,x$2->2,x$3->2}}}

Но если кто-то изменит размер проблемы на один шаг дальше с n = 4, вы увидите результат. Решение давно не появляется в моем ноутбуке.

Теперь простой вопрос: думает ли кто-нибудь здесь, что есть способ численно эффективно решить эту проблему в системе Mathematica для многомерных случаев? Делимся своими идеями и опытом. Однако следует помнить, что это тестовая задача нелинейной глобальной оптимизации. Большинство численных алгоритмов поиска корня / минимизации обычно ищут локальный минимум.

BR

P