Identifying & linking common vertices in 2 or more unequal multi-graphs?

[arnobosse]

I’ve just started teaching myself to work with graphs, and have created two, directed edge multi-graphs of letters from two sets of matched author and recipient lists. The graphs are unequal because they have different total numbers of author/recipients. Here, in a simplified form, is what I’ve been doing so far:

adAuthors={"mary", "peter", "peter", "peter"}
adRecipients={"jane", "arthur", "diana", "diana"}
adGraph=Graph[Thread[DirectedEdge[adAuthors, adRecipients]], VertexLabels -> Placed["Name", Tooltip]]

In other words, Mary wrote a letter to Jane, and Peter wrote letters to Arthur and (twice) to Diana. This data is a subset from a much larger dataset with many more attributes and where the authors and recipients are identified by their ID numbers. The second graph is constructed the same way. Here’s an example output using my real data:

I know that the two graphs (though of unequal length) share several common authors and recipients, and I’d like to find their list of common vertices, and also show this in a combined graph, indicating where the two graphs are connected. Later, I’d like to repeat this procedure for several more graphs, all sharing a small number of common authors and recipients.

Could someone offer some suggestions on how best to approach this? I’m very open to importing and working with my original spreadsheet data in MMA differently and more efficiently. These were just my very first beginner’s steps — many thanks.

[mthiel (Marco Thiel)]

HI Arno,

I am not sure whether this is what you need, but here are some pieces of code. First I create two similar graphs with some common nodes.

adAuthors = {"mary", "peter", "peter", "peter"};
adRecipients = {"jane", "arthur", "diana", "diana"};
adAuthors2 = {"paul", "victor", "mary", "diana", "peter"};
adRecipients2 = {"peter", "mary", "paul", "paul", "alonso"};

We can plot the graphs separately:

adGraph = 
 Graph[Thread[DirectedEdge[adAuthors, adRecipients]], 
  VertexLabels -> Placed["Name", Tooltip]]

and

adGraph2 = 
 Graph[Thread[DirectedEdge[adAuthors2, adRecipients2]], 
  VertexLabels -> Placed["Name", Tooltip]]

We can user Union to generate a list of all authors and all recipients.

Union[adAuthors, adAuthors2]
(*{"diana", "mary", "paul", "peter", "victor"}*)

and

Union[adRecipients, adRecipients2]
(*{"alonso", "arthur", "diana", "jane", "mary", "paul", "peter"}*)

We can also plot the joint graph like so:

adGraphjoin = 
 Graph[Thread[DirectedEdge[Join[adAuthors, adAuthors2], Join[adRecipients, adRecipients2]]], 
  VertexLabels -> Placed["Name", Tooltip]]

So a combination of Union and Join functions should do the trick for you.

Best wishes from Aberdeen and thanks again for the great conference/workshop in Oxford,
Marco

[Vitaliyk (Vitaliy Kaurov)]

Some thoughts to add to Marco’s… Let’s get a list of many random names:

names = EntityValue[RandomEntity["GivenName", 100], "Name"]

Get two non-intersecting sets:

adAuthors = names[[;; 30]];
adRecipients = names[[-30 ;;]];

Create a symbol that can get 2 random potentially overlapping graphs:

adGraph := 
  Graph[Thread[
    DirectedEdge[RandomChoice[adAuthors, 40], 
     RandomChoice[adRecipients, 40]]], VertexLabels -> "Name", 
   GraphLayout -> "BipartiteEmbedding", 
   Background -> RandomColor[Hue[_, .5]], ImageSize -> 400];

and get 2 random graphs:

adGraphSAMPLE = {adGraph, adGraph}

See intersections of edges and vertices:

interVert = Intersection @@ (VertexList /@ adGraphSAMPLE)
interEdges = Intersection @@ (EdgeList /@ adGraphSAMPLE)

Visualize in your graphs:

HighlightGraph[#, Join[interVert, interEdges],
   GraphLayout -> "BipartiteEmbedding", VertexLabels -> "Name", 
   GraphHighlightStyle -> "Thick"] & /@ adGraphSAMPLE

[arnobosse]

Marco and Vitaliy, thank you both very much for your patient and generous responses. I will have time tomorrow to look at them more carefully.

[Vitaliyk (Vitaliy Kaurov)]

…friendships forged in fire @Arno Bosse @Marco Thiel