# Find parallel line numbers in a graph

Suppose I have a graph formed by 3 vertices and 4 lines. {4 <-> 1, 1 <-> 3, 3 <-> 4, 1 <-> 3} Let the line numbers be {1,2,3,4}. Now lines 2&4 are parallel lines.

Suppose I have a graph with 5000 vertices and 5500 lines.Assuming there are 300 parallel lines in the graph,how would you identify them along with line numbers? In other words, how would you identify such parallel lines and its corresponding line numbers in a big graph?

• Could you clarify how you define parallel in this context? Commented Jul 1, 2018 at 5:49
• @MarcoB "Parallel edges" typically refers to edges connecting the same vertices. Commented Jul 1, 2018 at 6:13
• What are you actually trying to do? IGraph/M has several tools that help in dealing with multigraphs. E.g., IGWeightedSimpeGraph will merge parallel edges and sum their weights. Commented Jul 1, 2018 at 6:19
• @Szabolcs thank you for the clarification. I wasn’t aware of that. Commented Jul 1, 2018 at 6:23
• @Szabolcs If I assign line numbers to every line, and form a graph and that graph has parallel lines, I want to get only the numbers of parallel lines Commented Jul 1, 2018 at 6:34

You can identify the indices of parallel edges using

GroupBy[
Range@EdgeCount[g] -> (Sort /@ EdgeList[g])
],
Last -> First
]

(* <|1 \[UndirectedEdge] 4 -> {1}, 1 \[UndirectedEdge] 3 -> {2, 4}, 3 \ [UndirectedEdge] 4 -> {3}|> *)


Here is a solution based on Tally for obtaining the edges that have parallels:

edgeRules = {4 <-> 1, 1 <-> 3, 4 <-> 3, 3 <-> 1, 4 <-> 3, 3 <-> 4};
g = Graph[edgeRules];

parallelEdges =
First /@ Select[Tally[Sort /@ EdgeList[g]], Last[#] > 1 &]

(*  {1 \[UndirectedEdge] 3, 3 \[UndirectedEdge] 4}  *)


That is simple enough, but it gets a little more complicated if we want the position of the edges in the original edgeRules. We could do something like this:

lineNumbers = Flatten[Union[Position[edgeRules, #],
Position[edgeRules, Reverse[#]]]] & /@
TwoWayRule @@@ parallelEdges

(*  {{2, 4}, {3, 5, 6}}  *)


And retrieve the original rules that generated the parallel edges like this:

parallelRules = Part[edgeRules, #] & /@ lineNumbers

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

edges = {4 <-> 1, 1 <-> 3, 3 <-> 4, 3 <-> 1} ;
Select[Length @ # >= 2 &] @ GatherBy[Range @ Length @ edges, Sort @ edges[[#]]&]


{{2, 4}}

Also

Select[Length @ # >= 2 &] @ Values @
GroupBy[edges, (Sort @ # &) -> (Flatten[Position[edges, #]]&), First[#]&]

ac = ArrayComponents[Sort /@ edges];
Select[Length@# >= 2 &]@ Values@GroupBy[Range@Length@edges, ac[[#]] &]


both give

{{2, 4}}