Revisions to Find k largest edges with unique nodes (kind of maximum weighted matching)

added 245 characters in body

Source Link

edited Oct 26, 2018 at 20:25

400.5k
18
488
929

Update: a greedy approach:

am = WeightedAdjacencyMatrix[g1];
DeleteDuplicates[am["NonzeroPositions"][[Ordering[-am["NonzeroValues"]]]][[;; ;; 2]], 
  IntersectingQ]

{{4, 5}, {1, 2}, {6, 8}}

Original answer:

ClearAll[f]
f = Module[{dm = Array[a, {1, 1} VertexCount[#], 1], constraints1, 
      constraints2, constraints3, objective},
  constraints1 = Join @@ Join[Thread[0 <= # <= 1] & /@ dm, 
      Thread[0 <= # <= 1] & /@ Transpose[dm]];
  constraints2 = 0 <= Total[{#, Reverse /@ #}, 2] <= 1 & /@ dm;
  constraints3 = {Total[dm, 2] == #2};
  constraints4 = DeleteCases[Thread[Join@@dm ==Join@@(dm  Unitize[am])], True];
  objective = Total[dm WeightedAdjacencyMatrix[#], 2];
  Maximize[{objective, ## & @@ 
   Join[constraints1, constraints2, constraints3, constraints4]}, Join @@ dm, Integers]]&;

Examples:

edges = Property[#, EdgeWeight -> #2] & @@@ 
   Thread[{{1 <-> 2, 2 <-> 3, 3 <-> 4, 4 <-> 5, 4 <-> 6, 5 <-> 6, 
      6 <-> 7, 6 <-> 8, 7 <-> 8}, {3, 2, 1, 6, 5, 4, 1, 3, 2}}];
g1 = Graph[Range[8], edges, EdgeLabels -> "EdgeWeight", 
  VertexLabels -> Placed["Name", Center], VertexSize -> Large, ImageSize -> Large]

f[g1, 3] /. r : Rule[_, 1] :> Style[r, Red, Bold]

HighlightGraph[g1, Style[f[g1, 3][[2]] /. 
  Rule[a[b_, c_], 1] :> UndirectedEdge[b, c], {Red, Thickness[.02]}]]

HighlightGraph[g1, Style[f[g1, 2][[2]] /. 
   Rule[a[b_, c_], 1] :> UndirectedEdge[b, c], {Red, Thickness[.02]}]]

 HighlightGraph[g1, Style[f[g1, 4][[2]] /. 
   Rule[a[b_, c_], 1] :> UndirectedEdge[b, c], {Red, Thickness[.02]}]]

ClearAll[f]
f = Module[{dm = Array[a, {1, 1} VertexCount[#], 1], constraints1, 
      constraints2, constraints3, objective},
  constraints1 = Join @@ Join[Thread[0 <= # <= 1] & /@ dm, 
      Thread[0 <= # <= 1] & /@ Transpose[dm]];
  constraints2 = 0 <= Total[{#, Reverse /@ #}, 2] <= 1 & /@ dm;
  constraints3 = {Total[dm, 2] == #2};
  constraints4 = DeleteCases[Thread[Join@@dm ==Join@@(dm  Unitize[am])], True];
  objective = Total[dm WeightedAdjacencyMatrix[#], 2];
  Maximize[{objective, ## & @@ 
   Join[constraints1, constraints2, constraints3, constraints4]}, Join @@ dm, Integers]]&;

Examples:

edges = Property[#, EdgeWeight -> #2] & @@@ 
   Thread[{{1 <-> 2, 2 <-> 3, 3 <-> 4, 4 <-> 5, 4 <-> 6, 5 <-> 6, 
      6 <-> 7, 6 <-> 8, 7 <-> 8}, {3, 2, 1, 6, 5, 4, 1, 3, 2}}];
g1 = Graph[Range[8], edges, EdgeLabels -> "EdgeWeight", 
  VertexLabels -> Placed["Name", Center], VertexSize -> Large, ImageSize -> Large]

f[g1, 3] /. r : Rule[_, 1] :> Style[r, Red, Bold]

HighlightGraph[g1, Style[f[g1, 3][[2]] /. 
  Rule[a[b_, c_], 1] :> UndirectedEdge[b, c], {Red, Thickness[.02]}]]

HighlightGraph[g1, Style[f[g1, 2][[2]] /. 
   Rule[a[b_, c_], 1] :> UndirectedEdge[b, c], {Red, Thickness[.02]}]]

 HighlightGraph[g1, Style[f[g1, 4][[2]] /. 
   Rule[a[b_, c_], 1] :> UndirectedEdge[b, c], {Red, Thickness[.02]}]]

Update: a greedy approach:

am = WeightedAdjacencyMatrix[g1];
DeleteDuplicates[am["NonzeroPositions"][[Ordering[-am["NonzeroValues"]]]][[;; ;; 2]], 
  IntersectingQ]

{{4, 5}, {1, 2}, {6, 8}}

Original answer:

ClearAll[f]
f = Module[{dm = Array[a, {1, 1} VertexCount[#], 1], constraints1, 
      constraints2, constraints3, objective},
  constraints1 = Join @@ Join[Thread[0 <= # <= 1] & /@ dm, 
      Thread[0 <= # <= 1] & /@ Transpose[dm]];
  constraints2 = 0 <= Total[{#, Reverse /@ #}, 2] <= 1 & /@ dm;
  constraints3 = {Total[dm, 2] == #2};
  constraints4 = DeleteCases[Thread[Join@@dm ==Join@@(dm  Unitize[am])], True];
  objective = Total[dm WeightedAdjacencyMatrix[#], 2];
  Maximize[{objective, ## & @@ 
   Join[constraints1, constraints2, constraints3, constraints4]}, Join @@ dm, Integers]]&;

Examples:

edges = Property[#, EdgeWeight -> #2] & @@@ 
   Thread[{{1 <-> 2, 2 <-> 3, 3 <-> 4, 4 <-> 5, 4 <-> 6, 5 <-> 6, 
      6 <-> 7, 6 <-> 8, 7 <-> 8}, {3, 2, 1, 6, 5, 4, 1, 3, 2}}];
g1 = Graph[Range[8], edges, EdgeLabels -> "EdgeWeight", 
  VertexLabels -> Placed["Name", Center], VertexSize -> Large, ImageSize -> Large]

f[g1, 3] /. r : Rule[_, 1] :> Style[r, Red, Bold]

HighlightGraph[g1, Style[f[g1, 3][[2]] /. 
  Rule[a[b_, c_], 1] :> UndirectedEdge[b, c], {Red, Thickness[.02]}]]

HighlightGraph[g1, Style[f[g1, 2][[2]] /. 
   Rule[a[b_, c_], 1] :> UndirectedEdge[b, c], {Red, Thickness[.02]}]]

 HighlightGraph[g1, Style[f[g1, 4][[2]] /. 
   Rule[a[b_, c_], 1] :> UndirectedEdge[b, c], {Red, Thickness[.02]}]]

added 296 characters in body

Source Link

edited Oct 26, 2018 at 19:34

kglr

400.5k
18
488
929

ClearAll[f]
f = Module[{dm = Array[a, {1, 1} VertexCount[#], 1], constraints1, 
      constraints2, constraints3, objective},
    constraints1 = Join @@ Join[Thread[0 <= # <= 1] & /@ dm, 
       Thread[0 <= # <= 1] & /@ Transpose[dm]];
    constraints2 = 0 <= Total[{#, Reverse /@ #}, 2] <= 1 & /@ dm;
    constraints3 = {Total[dm, 2] == #2};
  constraints4 = DeleteCases[Thread[Join@@dm ==Join@@(dm  Unitize[am])], True];
  objective = Total[dm WeightedAdjacencyMatrix[#], 2];
    Maximize[{objective, ## & @@ 
       Join[constraints1, constraints2, constraints3]constraints3, constraints4]}, Join @@ dm, Integers]] &;Integers]]&;

Examples:

edges = Property[#, EdgeWeight -> #2] & @@@ 
   Thread[{{1 <-> 2, 2 <-> 3, 3 <-> 4, 4 <-> 5, 4 <-> 6, 5 <-> 6, 
      6 <-> 7, 6 <-> 8, 7 <-> 8}, {3, 2, 1, 6, 5, 4, 1, 3, 2}}];
g1 = Graph[Range[8], edges, EdgeLabels -> "EdgeWeight", 
  VertexLabels -> Placed["Name", Center], VertexSize -> Large, ImageSize -> Large]

f[g1, 3] /. r : Rule[_, 1] :> Style[r, Red, Bold]

HighlightGraph[g1, Style[f[g1, 3][[2]] /. 
  Rule[a[b_, c_], 1] :> UndirectedEdge[b, c], {Red, Thickness[.02]}]]

HighlightGraph[g1, Style[f[g1, 2][[2]] /. 
   Rule[a[b_, c_], 1] :> UndirectedEdge[b, c], {Red, Thickness[.02]}]]

 HighlightGraph[g1, Style[f[g1, 4][[2]] /. 
   Rule[a[b_, c_], 1] :> UndirectedEdge[b, c], {Red, Thickness[.02]}]]

ClearAll[f]
f = Module[{dm = Array[a, {1, 1} VertexCount[#], 1], constraints1, 
      constraints2, constraints3, objective},
    constraints1 = Join @@ Join[Thread[0 <= # <= 1] & /@ dm, 
       Thread[0 <= # <= 1] & /@ Transpose[dm]];
    constraints2 = 0 <= Total[{#, Reverse /@ #}, 2] <= 1 & /@ dm;
    constraints3 = {Total[dm, 2] == #2};
    objective = Total[dm WeightedAdjacencyMatrix[#], 2];
    Maximize[{objective, ## & @@ 
       Join[constraints1, constraints2, constraints3]}, Join @@ dm, Integers]] &;

Examples:

edges = Property[#, EdgeWeight -> #2] & @@@ 
   Thread[{{1 <-> 2, 2 <-> 3, 3 <-> 4, 4 <-> 5, 4 <-> 6, 5 <-> 6, 
      6 <-> 7, 6 <-> 8, 7 <-> 8}, {3, 2, 1, 6, 5, 4, 1, 3, 2}}];
g1 = Graph[Range[8], edges, EdgeLabels -> "EdgeWeight", 
  VertexLabels -> Placed["Name", Center], VertexSize -> Large, ImageSize -> Large]

f[g1, 3] /. r : Rule[_, 1] :> Style[r, Red, Bold]

HighlightGraph[g1, Style[f[g1, 3][[2]] /. 
  Rule[a[b_, c_], 1] :> UndirectedEdge[b, c], {Red, Thickness[.02]}]]

HighlightGraph[g1, Style[f[g1, 2][[2]] /. 
   Rule[a[b_, c_], 1] :> UndirectedEdge[b, c], {Red, Thickness[.02]}]]

ClearAll[f]
f = Module[{dm = Array[a, {1, 1} VertexCount[#], 1], constraints1, 
      constraints2, constraints3, objective},
  constraints1 = Join @@ Join[Thread[0 <= # <= 1] & /@ dm, 
      Thread[0 <= # <= 1] & /@ Transpose[dm]];
  constraints2 = 0 <= Total[{#, Reverse /@ #}, 2] <= 1 & /@ dm;
  constraints3 = {Total[dm, 2] == #2};
  constraints4 = DeleteCases[Thread[Join@@dm ==Join@@(dm  Unitize[am])], True];
  objective = Total[dm WeightedAdjacencyMatrix[#], 2];
  Maximize[{objective, ## & @@ 
   Join[constraints1, constraints2, constraints3, constraints4]}, Join @@ dm, Integers]]&;

Examples:

edges = Property[#, EdgeWeight -> #2] & @@@ 
   Thread[{{1 <-> 2, 2 <-> 3, 3 <-> 4, 4 <-> 5, 4 <-> 6, 5 <-> 6, 
      6 <-> 7, 6 <-> 8, 7 <-> 8}, {3, 2, 1, 6, 5, 4, 1, 3, 2}}];
g1 = Graph[Range[8], edges, EdgeLabels -> "EdgeWeight", 
  VertexLabels -> Placed["Name", Center], VertexSize -> Large, ImageSize -> Large]

f[g1, 3] /. r : Rule[_, 1] :> Style[r, Red, Bold]

HighlightGraph[g1, Style[f[g1, 3][[2]] /. 
  Rule[a[b_, c_], 1] :> UndirectedEdge[b, c], {Red, Thickness[.02]}]]

HighlightGraph[g1, Style[f[g1, 2][[2]] /. 
   Rule[a[b_, c_], 1] :> UndirectedEdge[b, c], {Red, Thickness[.02]}]]

 HighlightGraph[g1, Style[f[g1, 4][[2]] /. 
   Rule[a[b_, c_], 1] :> UndirectedEdge[b, c], {Red, Thickness[.02]}]]

added 226 characters in body

Source Link

edited Oct 26, 2018 at 19:19

kglr

400.5k
18
488
929

ClearAll[f]
f = Module[{dm = Array[a, {1, 1} VertexCount[#], 1], constraints1, 
      constraints2, constraints3, objective},
    constraints1 = Join @@ Join[Thread[0 <= # <= 1] & /@ dm, 
       Thread[0 <= # <= 1] & /@ Transpose[dm]];
    constraints2 = 0 <= Total[{#, Reverse /@ #}, 2] <= 1 & /@ dm;
    constraints3 = {Total[dm, 2] == #2};
    objective = Total[dm WeightedAdjacencyMatrix[#], 2];
    Maximize[{objective, ## & @@ 
       Join[constraints1, constraints2, constraints3]}, Join @@ dm]]dm, Integers]] &;

Examples:Examples:

edges = Property[#, EdgeWeight -> #2] & @@@ 
   Thread[{{1 <-> 2, 2 <-> 3, 3 <-> 4, 4 <-> 5, 4 <-> 6, 5 <-> 6, 
      6 <-> 7, 6 <-> 8, 7 <-> 8}, {3, 2, 1, 6, 5, 4, 1, 3, 2}}];
g1 = Graph[Range[8], edges, EdgeLabels -> "EdgeWeight", 
  VertexLabels -> Placed["Name", Center], VertexSize -> Large, ImageSize -> Large]

f[g1, 3] /. r : Rule[_, 1] :> Style[r, Red, Bold]

HighlightGraph[g1, Style[f[g1, 3][[2]] /. 
  Rule[a[b_, c_], 1] :> UndirectedEdge[b, c], {Red, Thickness[.02]}]]

HighlightGraph[g1, Style[f[g1, 2][[2]] /. 
   Rule[a[b_, c_], 1] :> UndirectedEdge[b, c], {Red, Thickness[.02]}]]

ClearAll[f]
f = Module[{dm = Array[a, {1, 1} VertexCount[#], 1], constraints1, 
     constraints2, constraints3, objective},
    constraints1 = Join @@ Join[Thread[0 <= # <= 1] & /@ dm, 
       Thread[0 <= # <= 1] & /@ Transpose[dm]];
    constraints2 = 0 <= Total[{#, Reverse /@ #}, 2] <= 1 & /@ dm;
    constraints3 = {Total[dm, 2] == #2};
    objective = Total[dm WeightedAdjacencyMatrix[#], 2];
    Maximize[{objective, ## & @@ 
       Join[constraints1, constraints2, constraints3]}, Join @@ dm]] &;

Examples:

edges = Property[#, EdgeWeight -> #2] & @@@ 
   Thread[{{1 <-> 2, 2 <-> 3, 3 <-> 4, 4 <-> 5, 4 <-> 6, 5 <-> 6, 
      6 <-> 7, 6 <-> 8, 7 <-> 8}, {3, 2, 1, 6, 5, 4, 1, 3, 2}}];
g1 = Graph[Range[8], edges, EdgeLabels -> "EdgeWeight", 
  VertexLabels -> Placed["Name", Center], VertexSize -> Large, ImageSize -> Large]

f[g1, 3] /. r : Rule[_, 1] :> Style[r, Red, Bold]

HighlightGraph[g1, Style[f[g1, 3][[2]] /. 
  Rule[a[b_, c_], 1] :> UndirectedEdge[b, c], {Red, Thickness[.02]}]]

ClearAll[f]
f = Module[{dm = Array[a, {1, 1} VertexCount[#], 1], constraints1, 
      constraints2, constraints3, objective},
    constraints1 = Join @@ Join[Thread[0 <= # <= 1] & /@ dm, 
       Thread[0 <= # <= 1] & /@ Transpose[dm]];
    constraints2 = 0 <= Total[{#, Reverse /@ #}, 2] <= 1 & /@ dm;
    constraints3 = {Total[dm, 2] == #2};
    objective = Total[dm WeightedAdjacencyMatrix[#], 2];
    Maximize[{objective, ## & @@ 
       Join[constraints1, constraints2, constraints3]}, Join @@ dm, Integers]] &;

Examples:

edges = Property[#, EdgeWeight -> #2] & @@@ 
   Thread[{{1 <-> 2, 2 <-> 3, 3 <-> 4, 4 <-> 5, 4 <-> 6, 5 <-> 6, 
      6 <-> 7, 6 <-> 8, 7 <-> 8}, {3, 2, 1, 6, 5, 4, 1, 3, 2}}];
g1 = Graph[Range[8], edges, EdgeLabels -> "EdgeWeight", 
  VertexLabels -> Placed["Name", Center], VertexSize -> Large, ImageSize -> Large]

f[g1, 3] /. r : Rule[_, 1] :> Style[r, Red, Bold]

HighlightGraph[g1, Style[f[g1, 3][[2]] /. 
  Rule[a[b_, c_], 1] :> UndirectedEdge[b, c], {Red, Thickness[.02]}]]

HighlightGraph[g1, Style[f[g1, 2][[2]] /. 
   Rule[a[b_, c_], 1] :> UndirectedEdge[b, c], {Red, Thickness[.02]}]]

Source Link

created Oct 26, 2018 at 19:09

kglr

400.5k
18
488
929

Loading

Stack Exchange Network

Return to Answer