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

I have a weighted graph, and I am interested to find k largest edges with unique nodes. Currently, I do it in the following manner

maxMatching[mat_,num_]:=Module[{res={},idxMax,aMax,temp=mat},
Table[idxMax=Nearest[temp["NonzeroValues"]->Automatic,Max[temp],1];
aMax=temp["NonzeroPositions"][[idxMax]];
AppendTo[res,aMax];
temp[[First[Flatten[aMax],1]]]=temp[[First[Flatten[aMax],1]]]*0;
temp[[All,Last[Flatten[aMax],1]]]=temp[[ Last[Flatten[aMax],1]]]*0;
temp
,{num}];
res
]


Any suggestion on how to speed up this calculation in huge matrices are welcome.

Edit: I speed up the calculation in factor ~5 by using a mask matrix and multiplication of the original matrix by the mask matrix.

maxMatching2[mat_, num_] :=
Module[{res = {}, idxMax, aMax, temp = mat, maskMatrix, pos1, pos2},
Table[idxMax =
Nearest[temp["NonzeroValues"] -> Automatic, Max[temp], 1];
aMax = temp["NonzeroPositions"][[idxMax]];
AppendTo[res, aMax];

pos1 =
temp[[First[Flatten[aMax], 1]]][
"NonzeroPositions"];(*temp1[[First[Flatten[aMax],1]]]*0;//
AbsoluteTiming*)
pos2 = temp[[All, Last[Flatten[aMax], 1]]]["NonzeroPositions"];
SparseArray[Join[rr, rr2] -> 0.0, Dimensions[temp], 1.0];
, num];
res
]


Edit 2 Assume in the following graph g1 I want to find 2 largest edges with unique nodes.

g1 = Graph[
{1<->2, 2<->3, 3<->4, 4<->5, 4<->6, 5<->6, 6<->7, 6<->8, 7<->8},
EdgeWeight -> {3, 2, 1, 6, 5, 4, 1, 3, 2},
EdgeLabels -> "EdgeWeight"
];


The first edge is the largest edge in the graph and the second edge is edge without common nodes.

The result will be the red edges in the graph

• It is not clear to me what is the actual goal. A short example would be useful. Oct 26, 2018 at 15:55
• @DanielLichtblau I added an example Oct 26, 2018 at 17:51
• Thanks. There remains a question. Are you trying to maximize total weight? Or just to have a greedy algorithm that successively selects the next qualified candidate edge at each step? Oct 26, 2018 at 19:43
• @DanielLichtblau Just a greedy algorithm Oct 27, 2018 at 2:08

Update: a greedy approach:

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


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

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];
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]}]]


• Thank you for the answer. Your greedy approach is what I am looking for, but unfortunately, it runs slowly, too. My input is a graph that has a few thousands of nodes and millions of edges. In my approach, the execution converges after ~ 5 hours, and your solution still runs (3+ hours). I am looking to speed up this calculation Oct 27, 2018 at 8:51

Interpretation

I can interpret the optimization problem in 2 ways:

1. Find the maximum total weight, even if it means that the largest weight is not included. Consider the following graph:

Graph[
{1<->2, 2<->3, 3<->4, 4<->5},
EdgeWeight -> {4, 6, 4, 1},
EdgeLabels -> "EdgeWeight"
]


For this graph, the maximum total weight is $$4+4$$ and not $$6+1$$.

2. Use a greedy algorithm, at each step selecting one of the largest weights. If there are multiple weights that can be chosen, then consider all possibilities choices for each step. Choose the possibility that produces the most large weight edges. For example, if one possibility produces the edge weights: $$6, 5, 3$$ and a different possibility produces the edge weights $$6, 6, 1$$ then the answer would be latter possibility, even though the former possibility has a larger total weight.

First Interpretation

For the first interpretation (the only one I will consider) you can use LinearProgramming:

MaxWeightEdges[g_, k_] := With[{i = IncidenceMatrix[g]},
Quiet[
LinearProgramming[
-PropertyValue[g, EdgeWeight],
Join[
{Table[1, EdgeCount[g]]},
i
],
Join[
{{k, -1}},
Table[{1, -1}, Length[i]]
],
Table[{0, 1}, EdgeCount[g]],
Integers
],
LinearProgramming::lpip
]
]


g1 = Graph[
{1<->2, 2<->3, 3<->4, 4<->5, 4<->6, 5<->6, 6<->7, 6<->8, 7<->8},
EdgeWeight -> {3, 2, 1, 6, 5, 4, 1, 3, 2},
EdgeLabels -> "EdgeWeight"
];

MaxWeightEdges[g1, 2]
MaxWeightEdges[g1, 3]


{1, 0, 0, 1, 0, 0, 0, 0, 0}

{1, 0, 0, 1, 0, 0, 0, 1, 0}

Motivated by the @kglr greedy approach, I speed up my calculation in the following manner:

resTest = {};
dataBaseOfNodes =
Association[
Table[i -> 1, {i, 1,
Length@DeleteDuplicates[Flatten[am ["NonzeroPositions"]]]}]];
sortedEdgeList =
am["NonzeroPositions"][[Ordering[-am ["NonzeroValues"]]]][[;; ;;2]];

k = 4;
Table[If[dataBaseOfNodes[First[sortedEdgeList [[j]]]]*
dataBaseOfNodes[First[sortedEdgeList [[j]]]] == 1 &&
Length[resTest] < k, AppendTo[resTest, sortedEdgeList [[j]]];
dataBaseOfNodes[First[sortedEdgeList [[j]]]] = 0;
dataBaseOfNodes[First[sortedEdgeList [[j]]]] = 0;,
Nothing[];];, {j, 1, Length@sortedEdgeList }]; // AbsoluteTiming