# Constructing multigraph from vertex list

Given a list of vertices, with each vertex containing an edge list:

vertices = {{"foo","3","bar"},{"3","bar"},{"foo"}}


How can I construct a multigraph where each unique string in the input is an edge, connecting the two vertices containing that edge? The following almost works, but restricts the graph to single edges:

RelationGraph[(ContainsAny[#1,#2] && #1!=#2)&, vertices]


The actual names of the edges in the output isn't important, just the topology of the graph.

• I looked at what your code generates and am confused. If you add VertexLabels->"Name" to your code, you can see what I mean. RelationGraph[(ContainsAny[#1, #2] && #1 != #2) &, vertices, VertexLabels -> "Name"] It is just as likely that I don't know what you are using for "vertices". It isn't the first code line, is it? It would help if you provided all inputs and your partially working code. Jun 18, 2019 at 3:19
• @MarkR That is the only line of code, aside from setting vertices to a list like the one above. The vertex {"foo","3","bar"} is connected to {"foo"} by the "foo" edge. It should also be connected to {"3","bar"} by the "3" and "bar" edges, but there is only one edge in the result. (The actual names of the edges in the output isn't important.) Jun 18, 2019 at 3:24

You can construct an adjacency matrix using Outer with Length @* Intersection as the first argument and use it with AdjacencyGraph:

am = Outer[Length @* Intersection, vertices, vertices, 1];
DirectedEdges -> True, VertexLabels -> "Name",
GraphLayout -> "CircularEmbedding"]


Alternatively, construct edge list using Outer and use Graph:

edgelist = Flatten[Outer[If[SameQ[##], {},
ConstantArray[DirectedEdge[##], Length[Intersection[##]]]] &,
vertices, vertices, 1]];
Graph[edgelist, VertexLabels -> "Name",  GraphLayout -> "CircularEmbedding"]


same picture

• Nice solution. If you want single (undirected) edges, how would you accomplish this? Jun 18, 2019 at 6:50
• @MarkR, remove DirectedEdges ->True in the first approach, for the second approach can't think of a way otomh.
– kglr
Jun 18, 2019 at 6:59
• thanks for letting me know. Removing "DirectedEdges->True is a nice change. Jun 18, 2019 at 7:24

Maybe the following will do what you want.

verticeEdgeDescription = {{"foo", "3", "bar"}, {"3",
"bar"}, {"foo"}};
(*give numbers to the vertices*)
vertexNumberPlusConnections = MapIndexed[{Last@#2, #1} &,verticeEdgeDescription];
combinations = Select[Tuples[vertexNumberPlusConnections, 2], #[[1]] != #[[2]] &];
combinations2 = DeleteDuplicates[Sort[#] & /@ combinations];
combinations3 = Select[{#[[1, 1]], #[[2, 1]], Intersection @@ #[[;; , -1]]} & /@ combinations2, #[[-1]] != {} &];
Graph[Flatten[With[{firstNode = #[[1]], secondNode = #[[2]], edges = #[[3]]},
Labeled[firstNode \[UndirectedEdge] secondNode, #] & /@
edges] & /@ combinations3], VertexLabels -> "Name", EdgeLabels -> "Name"]


This is mostly doing what you want. The one odd thing is that the labels in the generated graph seem wrong for the edges.

I'm not (yet) happy with how I determine the connections - too much manipulation to get unique connections.

Here is the connection edges: {Labeled[1 [UndirectedEdge] 2, "3"] , Labeled[1 [UndirectedEdge] 2, "bar"] , Labeled[1 [UndirectedEdge] 3, "foo"]}