# How can I check that a graph is edge weighted, fast?

I need to check if a graph is edge-weighted while maintaining good performance.

This should be an easy task, but it is not. It is a good example of why it is so terribly frustrating to work with graphs in Mathematica.

Here are three test graphs: a vertex-weighted one, an edge-weighted one, and a non-weighted graph.

vwg = Graph[{1, 2, 3}, {1 <-> 2}, VertexWeight -> {1, 2, 3}];
ewg = Graph[{1, 2, 3}, {1 <-> 2}, EdgeWeight -> {2}];
nwg = Graph[{1, 2, 3}, {1 <-> 2}];


You'd think that WeightedGraphQ works, but it returns True for vertex weighted graphs as well. (I reported this shortcoming long ago, but it's still not fixed.)

WeightedGraphQ /@ {vwg, ewg, nwg}
(* {True, True, False} *)


weightedGraphQ1[graph_?GraphQ] :=
MemberQ[PropertyList[graph], EdgeWeight]


Not, it doesn't work correctly:

weightedGraphQ1 /@ {vwg, ewg, nwg}
(* {True, True, False} *)


The only solution I found so far is

weightedGraphQ2[graph_?GraphQ] :=
WeightedGraphQ[graph] && PropertyValue[graph, EdgeWeight] =!= Automatic


This works:

weightedGraphQ2 /@ {vwg, ewg, nwg}
(* {False, True, False} *)


But it is awfully slow:

g = ExampleData[{"NetworkGraph", "CondensedMatterCollaborations2005"}];
weightedGraphQ2[g] // RepeatedTiming
(* {0.13, True} *)


There is no reason why it should be so slow:

WeightedAdjacencyMatrix[g]; // RepeatedTiming
(* {0.013, Null} *)

weightedGraphQ1[g]; // RepeatedTiming
(* {4.51*10^-6, Null} *)

WeightedGraphQ[g]; // RepeatedTiming
(* {3.91*10^-7, Null} *)


Is there any fast way to check if a graph is edge-weighted?

Failed ideas:

• Try to get it from Options[g]. It is just as slow as PropertyValue. The timing is about the same as converting an atomic graph to a compound expression (e.g. sending it through MathLink), so I assume this is what is happening.
• Use WeightedAdjacencyMatrix somehow. But then I can't distinguish between a graph which is unweighted and one in which all edge weights are 1.
• I found the potentially useful undocumented functions GraphComputationWeightValues and GraphComputationWeightVector, which return the edge and vertex weights, respectively. These functions will return the default weight value (i.e. 1) for unweighted graphs, thus they also can't be used to distinguish between weighted and unweighted graphs.

This is the best-performing solution I could come up with so far:

weightedGraphQ =
WeightedGraphQ[#] &&
With[{weights = GraphComputationWeightValues[#]},
If[First[weights] === 1 && SameQ @@ weights,
PropertyValue[#, EdgeWeight] =!= Automatic,
True
]
]&


This function performs multiple tests, in the order of increasing timing, and stops as soon as it can prove that the graph is edge weighted.

This is awfully hackish, but it should perform well in most practical cases.

It is risky though because I am relying on the fact that the default value for unspecified edge weights is precisely 1. Note that for custom properties it is possible set our own default value, e.g. by Properties -> {"DefaultEdgeProperties" -> {"foo" -> 5}}. This does not work for EdgeWeight, but it is not clear if that is by design or if it is an oversight.

• MinMax @ weights === {1, 1} or MinMax @ DeveloperToPackedArray @ weights === {1, 1} should be faster than SameQ @@ weights. – Carl Woll Dec 21 '17 at 15:05
• Thanks @Carl! With this, and your earlier help, transferring large weighted graphs to igraph is 6-7 times faster than before in the IGraph/M package. – Szabolcs Dec 21 '17 at 15:40
• Happy to be of service! – Carl Woll Dec 21 '17 at 15:48
• I debugged it through to see if there is internally a faster function that is called when you access AbsoluteOptions. It comes down to a call to GraphComputationGraphDeveloperDumpabsoluteOptions. For your specific case of EdgeWeight, it seems simply Options is called. For your large graph, Options[g,EdgeWeight] is still faster than PropertyValue. If we acknowledge that your minmax-weights test only needs 7*^-6 seconds, it is indeed 3500x faster :) – halirutan Dec 28 '17 at 11:39

This is the best performing 10.0-compatible solution I could find so far:

If[\$VersionNumber >= 10.1, (* MinMax was added in M10.1 *)
minMax = MinMax,
minMax = {Min[#], Max[#]}&
];

vertexWeightedQ[g_] :=
WeightedGraphQ[g] &&
With[{weights = DeveloperToPackedArray@GraphComputationWeightVector[g]},
If[First[weights] === 1 && minMax[weights] === {1, 1},
PropertyValue[g, VertexWeight] =!= Automatic,
True
]
]

edgeWeightedQ[g_?EmptyGraphQ] := False (* avoid error with First if graph has no edges but is vertex weighted *)
edgeWeightedQ[g_] :=
WeightedGraphQ[g] &&
With[{weights = DeveloperToPackedArray@GraphComputationWeightValues[g]},
If[First[weights] === 1 && minMax[weights] === {1, 1},
PropertyValue[g, EdgeWeight] =!= Automatic,
True
]
]


If anyone can find a solution that is no slower than this for any graph, but is noticeably faster for some, I am offering a bounty.