2
$\begingroup$

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.

$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – Mark R Jun 18 at 3:19
  • $\begingroup$ @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.) $\endgroup$ – Woofmao Jun 18 at 3:24
4
$\begingroup$

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];
AdjacencyGraph[vertices, am - DiagonalMatrix[Diagonal[am]],
 DirectedEdges -> True, VertexLabels -> "Name", 
 GraphLayout -> "CircularEmbedding"]

enter image description here

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

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

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.

Generated Graph

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

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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