Skip to main content
replaced http://mathematica.stackexchange.com/ with https://mathematica.stackexchange.com/
Source Link
mergeV[g_, v1_, v2_] := Graph[#[[1]], EdgeWeight -> #[[2]], EdgeLabels -> "EdgeWeight", 
      VertexLabels -> Placed["Name", Center], VertexSize -> 0.3] &@
 Transpose[
  Transpose[{EdgeList[g], PropertyValue[g, EdgeWeight]}] /. 
     {v1-> new, v2 -> new} /. {new \[DirectedEdge] new, x_} -> Sequence[] //. 
     {a___, {new \[DirectedEdge] x_, k1_}, b___, {new \[DirectedEdge] x_, k2_}, c___} -> {a, {new \[DirectedEdge] x, k1 + k2}, b, c} //. 
     {a___, {x_ \[DirectedEdge] new, k1_}, b___, {x_ \[DirectedEdge] new, k2_}, c___} -> {a, {x \[DirectedEdge] new, k1 + k2}, b, c}]

mergeV[g, a, b]

Mathematica graphics

Edit

Also, using the adjacency matrix:

m = WeightedAdjacencyMatrix[g];
{f1, f2} = VertexIndex[g, #] & /@ {a, b};
m[[f2]] += m[[f1]];
m[[All, f2]] += m[[All, f1]];
m = Delete[Transpose[Delete[m, f1]], f1] + SparseArray[{{i_, i_} -> Infinity}, Length@m -1 {1, 1}];
WeightedAdjacencyGraph[(Delete[VertexList@g /. b -> new, f1]), m, 
             VertexLabels -> Placed["Name", Center], EdgeLabels -> "EdgeWeight", VertexSize -> 0.3]

For the operations on rows and columns see thissee this

mergeV[g_, v1_, v2_] := Graph[#[[1]], EdgeWeight -> #[[2]], EdgeLabels -> "EdgeWeight", 
      VertexLabels -> Placed["Name", Center], VertexSize -> 0.3] &@
 Transpose[
  Transpose[{EdgeList[g], PropertyValue[g, EdgeWeight]}] /. 
     {v1-> new, v2 -> new} /. {new \[DirectedEdge] new, x_} -> Sequence[] //. 
     {a___, {new \[DirectedEdge] x_, k1_}, b___, {new \[DirectedEdge] x_, k2_}, c___} -> {a, {new \[DirectedEdge] x, k1 + k2}, b, c} //. 
     {a___, {x_ \[DirectedEdge] new, k1_}, b___, {x_ \[DirectedEdge] new, k2_}, c___} -> {a, {x \[DirectedEdge] new, k1 + k2}, b, c}]

mergeV[g, a, b]

Mathematica graphics

Edit

Also, using the adjacency matrix:

m = WeightedAdjacencyMatrix[g];
{f1, f2} = VertexIndex[g, #] & /@ {a, b};
m[[f2]] += m[[f1]];
m[[All, f2]] += m[[All, f1]];
m = Delete[Transpose[Delete[m, f1]], f1] + SparseArray[{{i_, i_} -> Infinity}, Length@m -1 {1, 1}];
WeightedAdjacencyGraph[(Delete[VertexList@g /. b -> new, f1]), m, 
             VertexLabels -> Placed["Name", Center], EdgeLabels -> "EdgeWeight", VertexSize -> 0.3]

For the operations on rows and columns see this

mergeV[g_, v1_, v2_] := Graph[#[[1]], EdgeWeight -> #[[2]], EdgeLabels -> "EdgeWeight", 
      VertexLabels -> Placed["Name", Center], VertexSize -> 0.3] &@
 Transpose[
  Transpose[{EdgeList[g], PropertyValue[g, EdgeWeight]}] /. 
     {v1-> new, v2 -> new} /. {new \[DirectedEdge] new, x_} -> Sequence[] //. 
     {a___, {new \[DirectedEdge] x_, k1_}, b___, {new \[DirectedEdge] x_, k2_}, c___} -> {a, {new \[DirectedEdge] x, k1 + k2}, b, c} //. 
     {a___, {x_ \[DirectedEdge] new, k1_}, b___, {x_ \[DirectedEdge] new, k2_}, c___} -> {a, {x \[DirectedEdge] new, k1 + k2}, b, c}]

mergeV[g, a, b]

Mathematica graphics

Edit

Also, using the adjacency matrix:

m = WeightedAdjacencyMatrix[g];
{f1, f2} = VertexIndex[g, #] & /@ {a, b};
m[[f2]] += m[[f1]];
m[[All, f2]] += m[[All, f1]];
m = Delete[Transpose[Delete[m, f1]], f1] + SparseArray[{{i_, i_} -> Infinity}, Length@m -1 {1, 1}];
WeightedAdjacencyGraph[(Delete[VertexList@g /. b -> new, f1]), m, 
             VertexLabels -> Placed["Name", Center], EdgeLabels -> "EdgeWeight", VertexSize -> 0.3]

For the operations on rows and columns see this

added 106 characters in body
Source Link
Dr. belisarius
  • 116.2k
  • 13
  • 205
  • 456
mergeV[g_, v1_, v2_] := Graph[#[[1]], EdgeWeight -> #[[2]], EdgeLabels -> "EdgeWeight", 
      VertexLabels -> Placed["Name", Center], VertexSize -> 0.3] &@
 Transpose[
  Transpose[{EdgeList[g], PropertyValue[g, EdgeWeight]}] /. 
     {v1-> new, v2 -> new} /. {new \[DirectedEdge] new, x_} -> Sequence[] //. 
     {a___, {new \[DirectedEdge] x_, k1_}, b___, {new \[DirectedEdge] x_, k2_}, c___} -> {a, {new \[DirectedEdge] x, k1 + k2}, b, c} //. 
     {a___, {x_ \[DirectedEdge] new, k1_}, b___, {x_ \[DirectedEdge] new, k2_}, c___} -> {a, {x \[DirectedEdge] new, k1 + k2}, b, c}]

mergeV[g, a, b]

Mathematica graphics

Edit

Also, using the adjacency matrix:

m = WeightedAdjacencyMatrix[g];
ff{f1, f2} = VertexIndex[g, #] & /@ {a, b};
m[[ff[[2]]]] = m[[ff[[1]]]] + m[[ff[[2]]]];
mm[[f2]] =+= Transpose[m];m[[f1]];
m[[ff[[2]]]]m[[All, =f2]] m[[ff[[1]]]]+= +m[[All, m[[ff[[2]]]];f1]];
m = Delete[Transpose[Delete[m, ff[[1]]]]f1]], ff[[1]]]+f1] + SparseArray[{{i_, i_} -> Infinity}, Length@m -1 {1, 1}];
g1 = WeightedAdjacencyGraph[(Delete[VertexList@g /. b -> new, ff[[1]]]f1]), m, 
             VertexLabels -> Placed["Name", Center], EdgeLabels -> "EdgeWeight",    VertexSize -> 0.3]

For the operations on rows and columns see this

mergeV[g_, v1_, v2_] := Graph[#[[1]], EdgeWeight -> #[[2]], EdgeLabels -> "EdgeWeight", 
      VertexLabels -> Placed["Name", Center], VertexSize -> 0.3] &@
 Transpose[
  Transpose[{EdgeList[g], PropertyValue[g, EdgeWeight]}] /. 
     {v1-> new, v2 -> new} /. {new \[DirectedEdge] new, x_} -> Sequence[] //. 
     {a___, {new \[DirectedEdge] x_, k1_}, b___, {new \[DirectedEdge] x_, k2_}, c___} -> {a, {new \[DirectedEdge] x, k1 + k2}, b, c} //. 
     {a___, {x_ \[DirectedEdge] new, k1_}, b___, {x_ \[DirectedEdge] new, k2_}, c___} -> {a, {x \[DirectedEdge] new, k1 + k2}, b, c}]

mergeV[g, a, b]

Mathematica graphics

Edit

Also, using the adjacency matrix:

m = WeightedAdjacencyMatrix[g];
ff = VertexIndex[g, #] & /@ {a, b};
m[[ff[[2]]]] = m[[ff[[1]]]] + m[[ff[[2]]]];
m = Transpose[m];
m[[ff[[2]]]] = m[[ff[[1]]]] + m[[ff[[2]]]];
m = Delete[Transpose[Delete[m, ff[[1]]]], ff[[1]]]+ SparseArray[{{i_, i_} -> Infinity}, Length@m {1, 1}];
g1 = WeightedAdjacencyGraph[(Delete[VertexList@g /. b -> new, ff[[1]]]), m,
  VertexLabels -> Placed["Name", Center], EdgeLabels -> "EdgeWeight",    VertexSize -> 0.3]
mergeV[g_, v1_, v2_] := Graph[#[[1]], EdgeWeight -> #[[2]], EdgeLabels -> "EdgeWeight", 
      VertexLabels -> Placed["Name", Center], VertexSize -> 0.3] &@
 Transpose[
  Transpose[{EdgeList[g], PropertyValue[g, EdgeWeight]}] /. 
     {v1-> new, v2 -> new} /. {new \[DirectedEdge] new, x_} -> Sequence[] //. 
     {a___, {new \[DirectedEdge] x_, k1_}, b___, {new \[DirectedEdge] x_, k2_}, c___} -> {a, {new \[DirectedEdge] x, k1 + k2}, b, c} //. 
     {a___, {x_ \[DirectedEdge] new, k1_}, b___, {x_ \[DirectedEdge] new, k2_}, c___} -> {a, {x \[DirectedEdge] new, k1 + k2}, b, c}]

mergeV[g, a, b]

Mathematica graphics

Edit

Also, using the adjacency matrix:

m = WeightedAdjacencyMatrix[g];
{f1, f2} = VertexIndex[g, #] & /@ {a, b};
m[[f2]] += m[[f1]];
m[[All, f2]] += m[[All, f1]];
m = Delete[Transpose[Delete[m, f1]], f1] + SparseArray[{{i_, i_} -> Infinity}, Length@m -1 {1, 1}];
WeightedAdjacencyGraph[(Delete[VertexList@g /. b -> new, f1]), m, 
             VertexLabels -> Placed["Name", Center], EdgeLabels -> "EdgeWeight", VertexSize -> 0.3]

For the operations on rows and columns see this

deleted 19 characters in body
Source Link
Dr. belisarius
  • 116.2k
  • 13
  • 205
  • 456
mergeV[g_, v1_, v2_] := Graph[#[[1]], EdgeWeight -> #[[2]], EdgeLabels -> "EdgeWeight", 
      VertexLabels -> Placed["Name", Center], VertexSize -> 0.3] &@
 Transpose[
  Transpose[{EdgeList[g], PropertyValue[g, EdgeWeight]}] /. 
     {v1-> new, v2 -> new} /. {new \[DirectedEdge] new, x_} -> Sequence[] //. 
     {a___, {new \[DirectedEdge] x_, k1_}, b___, {new \[DirectedEdge] x_, k2_}, c___} -> {a, {new \[DirectedEdge] x, k1 + k2}, b, c} //. 
     {a___, {x_ \[DirectedEdge] new, k1_}, b___, {x_ \[DirectedEdge] new, k2_}, c___} -> {a, {x \[DirectedEdge] new, k1 + k2}, b, c}]

mergeV[g, a, b]

Mathematica graphics

Edit

Also, using the adjacency matrix:

m = WeightedAdjacencyMatrix[g];
ff = Flatten[Position[VertexList@gVertexIndex[g, #] & /@ {a, b}, 2];
m[[ff[[2]]]] = m[[ff[[1]]]] + m[[ff[[2]]]];
m = Transpose[m];
m[[ff[[2]]]] = m[[ff[[1]]]] + m[[ff[[2]]]];
m = Delete[Transpose[Delete[m, ff[[1]]]], ff[[1]]]+ SparseArray[{{i_, i_} -> Infinity}, Length@m {1, 1}];
g1 = WeightedAdjacencyGraph[(Delete[VertexList@g /. b -> new, ff[[1]]]), m,
  VertexLabels -> Placed["Name", Center], EdgeLabels -> "EdgeWeight",    VertexSize -> 0.3]
mergeV[g_, v1_, v2_] := Graph[#[[1]], EdgeWeight -> #[[2]], EdgeLabels -> "EdgeWeight", 
      VertexLabels -> Placed["Name", Center], VertexSize -> 0.3] &@
 Transpose[
  Transpose[{EdgeList[g], PropertyValue[g, EdgeWeight]}] /. 
     {v1-> new, v2 -> new} /. {new \[DirectedEdge] new, x_} -> Sequence[] //. 
     {a___, {new \[DirectedEdge] x_, k1_}, b___, {new \[DirectedEdge] x_, k2_}, c___} -> {a, {new \[DirectedEdge] x, k1 + k2}, b, c} //. 
     {a___, {x_ \[DirectedEdge] new, k1_}, b___, {x_ \[DirectedEdge] new, k2_}, c___} -> {a, {x \[DirectedEdge] new, k1 + k2}, b, c}]

mergeV[g, a, b]

Mathematica graphics

Edit

Also, using the adjacency matrix:

m = WeightedAdjacencyMatrix[g];
ff = Flatten[Position[VertexList@g, #] & /@ {a, b}, 2]
m[[ff[[2]]]] = m[[ff[[1]]]] + m[[ff[[2]]]];
m = Transpose[m];
m[[ff[[2]]]] = m[[ff[[1]]]] + m[[ff[[2]]]];
m = Delete[Transpose[Delete[m, ff[[1]]]], ff[[1]]]+ SparseArray[{{i_, i_} -> Infinity}, Length@m {1, 1}];
g1 = WeightedAdjacencyGraph[(Delete[VertexList@g /. b -> new, ff[[1]]]), m,
  VertexLabels -> Placed["Name", Center], EdgeLabels -> "EdgeWeight",    VertexSize -> 0.3]
mergeV[g_, v1_, v2_] := Graph[#[[1]], EdgeWeight -> #[[2]], EdgeLabels -> "EdgeWeight", 
      VertexLabels -> Placed["Name", Center], VertexSize -> 0.3] &@
 Transpose[
  Transpose[{EdgeList[g], PropertyValue[g, EdgeWeight]}] /. 
     {v1-> new, v2 -> new} /. {new \[DirectedEdge] new, x_} -> Sequence[] //. 
     {a___, {new \[DirectedEdge] x_, k1_}, b___, {new \[DirectedEdge] x_, k2_}, c___} -> {a, {new \[DirectedEdge] x, k1 + k2}, b, c} //. 
     {a___, {x_ \[DirectedEdge] new, k1_}, b___, {x_ \[DirectedEdge] new, k2_}, c___} -> {a, {x \[DirectedEdge] new, k1 + k2}, b, c}]

mergeV[g, a, b]

Mathematica graphics

Edit

Also, using the adjacency matrix:

m = WeightedAdjacencyMatrix[g];
ff = VertexIndex[g, #] & /@ {a, b};
m[[ff[[2]]]] = m[[ff[[1]]]] + m[[ff[[2]]]];
m = Transpose[m];
m[[ff[[2]]]] = m[[ff[[1]]]] + m[[ff[[2]]]];
m = Delete[Transpose[Delete[m, ff[[1]]]], ff[[1]]]+ SparseArray[{{i_, i_} -> Infinity}, Length@m {1, 1}];
g1 = WeightedAdjacencyGraph[(Delete[VertexList@g /. b -> new, ff[[1]]]), m,
  VertexLabels -> Placed["Name", Center], EdgeLabels -> "EdgeWeight",    VertexSize -> 0.3]
added 609 characters in body
Source Link
Dr. belisarius
  • 116.2k
  • 13
  • 205
  • 456
Loading
added 609 characters in body
Source Link
Dr. belisarius
  • 116.2k
  • 13
  • 205
  • 456
Loading
Source Link
Dr. belisarius
  • 116.2k
  • 13
  • 205
  • 456
Loading