Квадратичное программирование в Mathematica - PullRequest
Новая
       43

Квадратичное программирование в Mathematica

3 голосов
/ 01 марта 2011

Я смотрю на квадратичную релаксацию задачи с максимальным независимым множеством (стр. 22 * ​​1001 * здесь ) и обнаружил, что FindMaximum терпит неудачу для каждого графа, который я пробую, если я не приведу оптимальное решение в качестве исходноготочка.Эти квадратичные программы имеют 10-20 переменных, поэтому я ожидаю, что они будут решаемыми.

  1. Есть ли способ заставить Mathematica решать такие квадратичные программы?
  2. Есть ли какой-нибудь пакет квадратичного программированияэто легко вызвать из Mathematica?

Вот пример сбоя FindMaximum, за которым следует FindMaximum, инициализированный в решении 

setupQuadratic[g_Graph] := (
   Ag = AdjacencyMatrix[g];
   A = IdentityMatrix[Length@VertexList@g] - Ag;
   cons = And @@ Table[0 <= x[v] <= 1, {v, VertexList@g}];
   vars = x /@ VertexList[g];
   indSet = FindIndependentVertexSet@g;
   xOpt = Array[Boole[MemberQ[indSet, #]] &, {Length@VertexList@g}];
   );

g = GraphData[{"Cubic", {10, 11}}];
setupQuadratic[g];
FindMaximum[{vars.A.vars, cons}, vars]
FindMaximum[{vars.A.vars, cons}, Thread[{vars, xOpt}]]

Вот другие графики, которые япробовал 

{"DodecahedralGraph", "FruchtGraph", "TruncatedPrismGraph", \
"TruncatedTetrahedralGraph", {"Cubic", {10, 2}}, {"Cubic", {10, 
   3}}, {"Cubic", {10, 4}}, {"Cubic", {10, 6}}, {"Cubic", {10, 
   7}}, {"Cubic", {10, 11}}, {"Cubic", {10, 12}}, {"Cubic", {12, 
   5}}, {"Cubic", {12, 6}}, {"Cubic", {12, 7}}, {"Cubic", {12, 
   9}}, {"Cubic", {12, 10}}}

Ответы [ 3 ]

2 голосов
/ 01 марта 2011

Можно попробовать метод, показанный в пакете, расположенном здесь .См. Проблему 8

Даниэль Лихтблау Вольфрам Исследования

1 голос
/ 01 марта 2011

Кажется, что Maximize будет служить вам лучше. Вот модифицированная версия вашей функции, которая возвращает список из 2 результатов - «ручной» и тот, который получен Maximize: 

Clear[findIVSet];
findIVSet[g_Graph] :=
Module[{Ag, A, cons, vars, indSet, indSetFromMaximize, xOpt},
  Ag = AdjacencyMatrix[g];
  A = IdentityMatrix[Length@VertexList@g] - Ag;
  cons = And @@ Table[0 <= x[v] <= 1, {v, VertexList@g}];
  vars = x /@ VertexList[g];
  indSet = FindIndependentVertexSet@g;
  xOpt = Array[Boole[MemberQ[indSet, #]] &, {Length@VertexList@g}];
  {indSet, DeleteCases[vars /. (Last@
    Maximize[{vars.A.vars, cons}, vars,Integers] /. (x[i_] -> 1) :> (x[i] -> i)), 0]}];

Вот результаты: 

In[32]:= graphs = GraphData /@ {"DodecahedralGraph", "FruchtGraph", 
"TruncatedPrismGraph", "TruncatedTetrahedralGraph", {"Cubic", {10, 2}}, {"Cubic", {10, 
  3}}, {"Cubic", {10, 4}}, {"Cubic", {10, 6}}, {"Cubic", {10, 
  7}}, {"Cubic", {10, 11}}, {"Cubic", {10, 12}}, {"Cubic", {12, 
  5}}, {"Cubic", {12, 6}}, {"Cubic", {12, 7}}, {"Cubic", {12, 
  9}}, {"Cubic", {12, 10}}};


In[33]:= sets = findIVSet /@ graphs

Out[33]= {{{1, 2, 3, 8, 10, 11, 17, 20}, {5, 6, 7, 8, 14, 15, 17, 18}},
{{2, 4, 6, 11, 12}, {2, 4, 6, 11, 12}}, {{2, 7, 10, 12, 16, 18}, {8, 11, 13, 16, 17, 18}}, 
{{1, 4, 7, 12}, {4, 7, 9, 12}}, {{2,3, 8, 9}, {2, 3, 8, 9}}, {{1, 4, 7, 10}, {2, 5, 8, 9}}, 
{{1, 4, 7, 10}, {2, 4, 7, 9}}, {{2, 4, 5, 8}, {3, 6, 7, 9}}, {{2, 5, 8, 9}, {2, 5, 8, 9}}, 
{{1, 3, 7, 10}, {4, 5, 8, 9}}, {{1, 6, 8, 9}, {2, 3, 6, 10}}, {{1, 6, 7, 12}, {4, 5, 9, 10}}, 
{{3, 4, 7, 8, 12}, {3, 4, 7, 8, 12}}, {{1, 5, 8, 9}, {4, 5, 10, 11}}, 
{{1, 5, 6, 9, 10}, {3, 4, 7, 8, 12}}, {{3, 4, 7, 9, 10}, {3, 4, 7, 9, 10}}}

Они не всегда одинаковы для "ручных" и тех, которые Maximize, но тогда есть больше, чем одно решение для независимого множества. Результаты Maximize являются независимыми наборами, что легко проверить: 

In[34]:= MapThread[IndependentVertexSetQ, {graphs, sets[[All, 2]]}]

Out[34]= {True, True, True, True, True, True, True, True, True, True, True, True, True, 
True, True,True}
0 голосов
/ 01 марта 2011

IMO, причина, по которой FindMaximum не работает, заключается в дикой природе вашей функции. Я пробовал сетку с 1 048 576 выборками в переменном пространстве, и ни одна из них не достигла более высокого значения, чем ноль. Ваше оптимальное начальное значение получает -20. 

In[10]:= (x[1]^2 + x[2]^2 + x[3]^2 - 2 x[3] x[4] + x[4]^2 - 
  2 x[2] (x[3] + x[4]) + x[5]^2 - 2 x[3] x[6] - 2 x[5] x[6] + 
  x[6]^2 - 2 x[5] x[7] + x[7]^2 - 2 x[6] x[8] - 2 x[7] x[8] + 
  x[8]^2 - 2 x[7] x[9] + x[9]^2 - 2 x[1] (x[2] + x[5] + x[9]) - 
  2 x[4] x[10] - 2 x[8] x[10] - 2 x[9] x[10] + x[10]^2 /. 
 Thread[vars -> #]) & @@@ Tuples[{0.0, 0.333, 0.667, 1.0}, 10] // Max

Out[10]= 0. 

In[11]:= (x[1]^2 + x[2]^2 + x[3]^2 - 2 x[3] x[4] + x[4]^2 - 
 2 x[2] (x[3] + x[4]) + x[5]^2 - 2 x[3] x[6] - 2 x[5] x[6] + 
 x[6]^2 - 2 x[5] x[7] + x[7]^2 - 2 x[6] x[8] - 2 x[7] x[8] + 
 x[8]^2 - 2 x[7] x[9] + x[9]^2 - 2 x[1] (x[2] + x[5] + x[9]) - 
 2 x[4] x[10] - 2 x[8] x[10] - 2 x[9] x[10] + x[10]^2 /. 
Thread[vars -> #]) & @@@ {xOpt}

Out[11]= {-20}
...