Implement edge contraction function which respects vertex weights

Question

It seems that built-in EdgeContract function doesn't work properly with weighted graphs, to be more precise, I mean that if I'm going to contract edge $e$ which connects vertex $v_1$ with weight $a$ and vertex $v_2$ with weight $b$ I expected to obtain one vertex which has $a+b$ weight.

So I'm going to implement my own function which will behave in the mentioned way.

My idea is to perform the following steps:

1. Use built-in EdgeContract function to obtain a new graph which has necessary numbers of edges and vertices.
2. Check which of vertices was deleted due to edge contraction and assign to another vertex weight equal to original plus weight of deleted vertex.
3. Assign new list of vertex weights to a graph obtained from the output of EdgeContract function early.

To implement this algorithm I wrote the following code:

contrEdge[graph_, edge_, weights_] :=
  new_weights = weights;
p1 = Flatten[Position[VertexList[graph], edge[[1]]]];
p2 = Flatten[Position[VertexList[graph], edge[[2]]]];
If[MemberQ[VertexList[EdgeContract[graph, edge]], edge[[1]]] == False,
   new_weights[[
    Flatten[Position[VertexList[new_graph], edge[[2]]]]]] = 
   weights[[p1]] + weights[[p2]],
  new_weights[[Flatten[Position[VertexList[new_graph], edge[[1]]]]]] =
    weights[[p1]] + weights[[p2]]
  ];
new_graph = 
  Graph[VertexList[EdgeContract[graph, edge]], 
   EdgeList[EdgeContract[graph, edge]], VertexWeight -> new_weights];

Here graph_ stands for input graph object, edge_ is for edge that we going to contract and weights_ stands for list of original weights.

Unfortunately it gives me a lot of errors and I can't manage to debug them.

I will be very grateful if someone helps me to understand what is going wrong, correct these errors and implement the desired function. Suggestions of simpler algorithms, if they exist, are also welcome.

Answer 1

ClearAll[edgeContract]
edgeContract[g_, e_] := Module[{ec = EdgeContract[g, e], v = VertexList[{e}], 
  t = Total[PropertyValue[{g, #}, VertexWeight] & /@ VertexList[{e}]] }, 
  SetProperty[ec, VertexWeight -> Append[# -> PropertyValue[{g, #}, VertexWeight] & /@ 
      Complement[VertexList[g], v], v[[1]] -> t]]]

Example:

 g1 = Graph[{1 <-> 2, 2 <-> 3,    3 <-> 1}, VertexWeight -> {2, 3, 4}]
 # -> PropertyValue[{g1, #}, VertexWeight] & /@ VertexList[g1]

{1 -> 2, 2 -> 3, 3 -> 4}

g2 = edgeContract[g1, 1 <-> 2];
# -> PropertyValue[{g2, #}, VertexWeight] & /@ VertexList[g2]

{3 -> 4, 1 -> 5}

Row[SetProperty[#, {ImageSize -> 300, VertexLabelStyle -> 18, ImagePadding -> 20, 
    VertexLabels -> {i_ :> Placed[{i, PropertyValue[{#, i}, VertexWeight]}, {Above, 
       Below}]}}] & /@ {g1, g2}]