22
$\begingroup$

Bug introduced in 8.0 or earlier and fixed in 12.0

I need create a weighted graph with given data.

Number of nodes: $53$ $\quad$ Number of edges: $91$

gp = 
  Graph[
    Table[data1[[i]] <-> data1[[i + 1]], {i, 1, 91 3, 3}], 
    EdgeWeight -> Table[data1[[i + 2]], {i, 1, 91 3, 3}],
    VertexLabels -> "Name"]

enter image description here

Then I take out some nodes and get a subgraph.

sub1 = 
  Subgraph[gp, 
    {28, 27, 26, 24, 23, 22, 17, 16, 15, 18, 21, 20, 25, 44, 46, 48, 49, 50, 51}, 
    EdgeLabels -> "EdgeWeight", VertexLabels -> "Name", ImageSize -> Large]

enter image description here

Why do all the weights become $1$?

Improve this question
$\endgroup$
9
  • 1
    $\begingroup$ Subgraph only returns edges and vertices. This is spelled out in the... wait for it... the documentation. You must add any weights that you want not one. $\endgroup$
    – ciao
    Commented Jul 28, 2015 at 3:14
  • $\begingroup$ Welcome to Mathematica.SE! I hope you will become a regular contributor. To get started, 1) take the introductory Tour now, 2) when you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge, 3) remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign, and 4) give help too, by answering questions in your areas of expertise. $\endgroup$
    – bbgodfrey
    Commented Jul 28, 2015 at 4:05
  • 12
    $\begingroup$ @ilian I really don't see why this isn't considered a bug ... it is not spelt out in the documentation that properties would get lost, nor can I see any reason why this should be the case. Other graph-handling libraries will preserve properties when taking subgraphs. $\endgroup$
    – Szabolcs
    Commented Jul 28, 2015 at 7:33
  • 4
    $\begingroup$ @ciao I agree with Szabolcs that this is NOT clearly stated in the documentation (I'd expect this in the Possible Issues section) and though this behaviour might not be considered a bug I do find it rather annoying. $\endgroup$
    – Sjoerd C. de Vries
    Commented Jul 28, 2015 at 9:32
  • 2
    $\begingroup$ @Szabolcs I agree. This has in fact been reported internally as a bug a while ago. Apologies for my misvote -- I relied on the first comment and neglected to look into it myself. Thanks for correcting. $\endgroup$
    – ilian
    Commented Jul 28, 2015 at 13:54

2 Answers 2

Reset to default
4
$\begingroup$

Update: IGraph/M now contains IGWeightedSubgraph, which can do this very fast. Part of this function are implemented in C to achieve excellent performance. I recommend you use it.

I use this workaround:

subgraph[wg_?GraphQ, {}] := Graph[{}, {}]
subgraph[wg_?GraphQ, vs_List] :=
 Module[{ind},
  ind = VertexIndex[wg, #] & /@ vs;
  IGWeightedAdjacencyGraph[
   VertexList[wg][[ind]],
   WeightedAdjacencyMatrix[wg][[ind, ind]],
   DirectedEdges -> DirectedGraphQ[wg]
   ]
  ]

IGWeightedAdjacencyGraph is from IGraph/M and differs from WeightedAdjacencyGraph in that it can treat zero elements of the matrix as missing edges (instead of Infinity elements).

I will reproduce the source here, as it is written in pure Mathematica:

(* When am is a SparseArray, we need to canonicalize it and ensure that it has no explicit value that is the same as the implicit one. *)
arrayRules[am_SparseArray, u_] := ArrayRules[SparseArray[am], u]
arrayRules[am_, u_] := ArrayRules[am, u]

IGWeightedAdjacencyGraph::usage =
    "IGWeightedAdjacencyGraph[matrix] creates a graph from a weighted adjacency matrix, taking the 0 weight to mean unconnected.\n" <>
    "IGWeightedAdjacencyGraph[vertices, matrix] uses vertices as the vertex names.\n" <>
    "IGWeightedAdjacencyGraph[matrix, z] creates a graph from a weighted adjacency matrix, taking the weight z to mean unconnected.\n" <>
    "IGWeightedAdjacencyGraph[vertices, matrix, z] uses vertices as the vertex names.";

IGWeightedAdjacencyGraph[wam_?SquareMatrixQ, unconnected : Except[_?OptionQ] : 0, opt : OptionsPattern[WeightedAdjacencyGraph]] :=
      WeightedAdjacencyGraph[
        SparseArray[Most@arrayRules[wam, unconnected], Dimensions[wam], Infinity],
        opt
      ]
IGWeightedAdjacencyGraph[vertices_List, wam_?SquareMatrixQ, unconnected : Except[_?OptionQ] : 0, opt : OptionsPattern[WeightedAdjacencyGraph]] :=
    WeightedAdjacencyGraph[
      vertices,
      SparseArray[Most@arrayRules[wam, unconnected], Dimensions[wam], Infinity],
      opt
    ]
Improve this answer
$\endgroup$
4
$\begingroup$

Update: In Mathematica 12.0, Subgraph preserved edge weights.

IGraph/M has a function to do this since version 0.3.97. Unlike the method using adjacency matrices, this function will also handle weighted multigraphs.

Thus, use IGWeightedSubgraph instead of Subgraph. Note that the second argument can only be a list of vertices. Unlike in Subgraph, edges and patterns are not currently supported.

This function is fast (partly implemented in C), but it preserves edge weights only. All other properties are discarded.

If you need to preserve all properties, use IGTake. IGTake[graph, subgraph] takes the vertices and edges of graph that are also present in subgraph and preserves all graph properties.

Examples

<< IGraphM`

IGraph/M 0.3.97.1 (February 4, 2018)

Evaluate IGDocumentation[] to get started.

g = ExampleData[{"NetworkGraph", "EastAfricaEmbassyAttacks"}]

enter image description here

vs = {"Osama", "Salim", "Abdullah", "Hage", "Abouhlaima", "Owhali"};

sg1 = Subgraph[g, vs]

enter image description here

The graph returned by Subgraph is not weighted:

IGEdgeWeightedQ[sg1]
(* False *)

IGWeightedSubgraph returns a weighted result, but all the original styling is lost.

sg2 = IGWeightedSubgraph[g, vs]

enter image description here

IGEdgeWeightedQ[sg2]
(* True *)

IGTakeSubgraph preserves all properties (and styling), but it is much slower than IGWeightedSubgraph.

sg3 = IGTake[g, Subgraph[g, vs]]

enter image description here

IGEdgeWeightedQ[sg3]
(* True *)

Verify that the edge weights in the subgraphs are correct.

Function[graph,
  PropertyValue[{graph, #}, EdgeWeight] & /@ EdgeList[sg1]
] /@ {g, sg2, sg3}
(* {{0.52, 0.48, 0.48, 0.36, 0.36, 0.36, 0.48, 0.16}, 
    {0.52, 0.48, 0.48, 0.36, 0.36, 0.36, 0.48, 0.16}, 
    {0.52, 0.48, 0.48, 0.36, 0.36, 0.36, 0.48, 0.16}} *)

Equal @@ %
(* True *)
Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.