# 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. – Mark R Jun 18 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.) – Woofmao Jun 18 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? – Mark R Jun 18 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 at 6:59
• thanks for letting me know. Removing "DirectedEdges->True is a nice change. – Mark R Jun 18 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"]}