Graph construction and computing for grouped elements with multiple interactions

Question

The goal is to build a graph consit of six elements (La, Le ,Li, Ka, Ke, Ki). La, Le, Li belong to group L, while Ka, Ke, Ki belong to group K. There are two differet interactions possible between the elements: mailing and meeting (undirected). In the image below the interactions and groups are shown.

How can make up this graph in Mathematica? How can I then get a track of a mail to be send from La to Ka? How can I find the link for mailing between the groups in Mathematica? Is it also possible to find tracks that an information, either passed by mailing or meeting, can take from one e.g La to Ki? I do not want to split it as the construction of the graph may be different with respect to the computations needed.

Update

I can built a graph,based on the interactions, like following:

Graph[{ "La" <-> "Le", "Le" <-> "Li", "Li" <-> "Ke", "Ke" <-> "Ka", 
  "Li" <-> "Le", "Le" <-> "Ka", "Ka" <-> "Ke", "Ka" <-> "Ki"}, 
 VertexLabels -> "Name"]

http://o8aucf9ny.bkt.clouddn.com/2016-12-23-08-27-01.png

But I cannot classify the edge to meet or mail to calculate.

Answer 1

This is really two problems, rendering and path finding. First let's fake an undirected multi-adjacency matrix graph:

spec = DeleteDuplicatesBy[
   {
    "La" <-> "Le", "Le" <-> "Li", "Li" <-> "Ke", "Ke" <-> "Ka", 
    "Li" <-> "Le", "Le" <-> "Ka", "Ka" <-> "Ke", "Ka" <-> "Ki"
    },
   Sort[List @@ #] &
   ];
spec = Flatten[
   spec /. UndirectedEdge[n_, 
      n2_] :> {Property[DirectedEdge[n, n2], 
       EdgeStyle -> Directive[Arrowheads[0], Red]], 
      Property[DirectedEdge[n2, n], 
       EdgeStyle -> Directive[Arrowheads[0], Green]]}];
g=Graph[spec, VertexLabels -> "Name"]

Looks like this:

Then you can apply any path finding algorithm to the adjacency matrix underlying the graph:

In[100]:= Normal@AdjacencyMatrix@spec

Out[100]= {{0, 1, 0, 0, 0, 0}, {1, 0, 1, 0, 1, 0}, {0, 1, 0, 1, 0, 
  0}, {0, 0, 1, 0, 1, 0}, {0, 1, 0, 1, 0, 1}, {0, 0, 0, 0, 1, 0}}

This is both the meet path adjacency matrix and the mail path one.

If you then want all mailing/meeting paths, that's pretty easy to do via some Floyd-Warshall like mechanism.

Answer 2

As an input I used:

vertexData={Property["La","group"->"L"],Property["Le","group"->"L"],Property["Li","group"->"L"],Property["Ka","group"->"K"],Property["Ke","group"->"K"],Property["Ki","group"->"K"]};
linkData=
{Property["La"<->"Le",{EdgeLabels->"mail",EdgeStyle->Blue,"interaction"->"mail"}],
Property["Le"<->"Li",{EdgeLabels->"meet",EdgeStyle->Green,"interaction"->"meet"}],
Property["Le"<->"Li",{EdgeLabels->"mail",EdgeStyle->Blue,"interaction"->"mail"}],
Property["Le"<->"Ka",{EdgeLabels->"meet",EdgeStyle->Green,"interaction"->"meet"}],
Property["Li"<->"Ke",{EdgeLabels->"mail",EdgeStyle->Blue,"interaction"->"mail"}],
Property["Ka"<->"Ke",{EdgeLabels->"meet",EdgeStyle->Green,"interaction"->"meet"}],
Property["Ka"<->"Ke",{EdgeLabels->"mail",EdgeStyle->Blue,"interaction"->"mail"}],
Property["Ka"<->"Ki",{EdgeLabels->"meet",EdgeStyle->Green,"interaction"->"meet"}]};

I tried to use the custom property differently but that was what came out in best case. In Graph these setting are just ignored. So the passing of an information (able to use "mail" and "meet" edges is just:

(*Path for an information to go, as it does not care about different \
interactions as information by definition*)
gFull = Graph[vertexData, linkData, VertexLabels -> "Name"];
infor = FindShortestPath[gFull, "La", "Ki"]

{"La", "Le", "Ka", "Ki"}

To visiualize it I needed to write my own function for the graph and the highlighting

(*make edges with its labels for GraphPlot*)
kanten = Flatten[{#[[1, 1]] -> #[[1, 2]]} & /@ linkData];
beschriftung = linkData[[All, 2, 1, 2]];
pltDat = Transpose[{kanten, beschriftung}];
(*Get grouping function*)
vertRand[vert_] := 
 Prepend[Flatten@
    Transpose[{vertexData[[All, 1]], vertexData[[All, 2, 2]]}], 
   vert] /. List -> Switch
(*give a list of verticies then those will be highlighted in Red, you \
can also give an empty list*)
(*Here with Frameimg the Verticies*)
ClearAll[grPltHigh];
grPltHigh[vertLst_: {}, edgLst_: {}] := 
 Module[{highVert = vertLst, highEdge = edgLst, markEdge},
  markEdge = {#[[1]], #[[2]]} & /@ EdgeList[highEdge]; 
  GraphPlot[pltDat, MultiedgeStyle -> 0.5, 
   EdgeRenderingFunction -> (If[#3 == 
        "mail", {If[(*edge highlighting*)
         MemberQ[markEdge, #2] || MemberQ[markEdge, Reverse@#2], Red, 
         Blue], Thickness[0.009], Line[#1], Black, 
        Inset[#3, Mean[#1], Automatic, Automatic, 
         Background -> Lighter@LightGray]}, {If[(*edge highlighting*)
         MemberQ[markEdge, #2] || MemberQ[markEdge, Reverse@#2], Red, 
         Green], Thickness[0.009], Line[#1], Black, 
        Inset[#3, Mean[#1], Automatic, Automatic, 
         Background -> Lighter@LightGray]}] &),
   VertexRenderingFunction -> (
     If[vertRand[#2] == "L", {Lighter@Orange, EdgeForm[Black],
        If[(*for highlighting as underlying rectangle in Red is made*) 
         MemberQ[highVert, #2], {Red, 
          Rectangle[#1 - {boxSize, boxSize}*1.3, #1 + {boxSize, 
              boxSize}*1.3]}], 
        Rectangle[#1 - {boxSize, boxSize}, #1 + {boxSize, boxSize}], 
        Black, Text[#2, #1]},
       If[vertRand[#2] == "K", {LightBlue, EdgeForm[Black],
         If[(*for highlighting as underlying rectangle in Red is made*)
          MemberQ[highVert, #2], {Red, 
           Rectangle[#1 - {boxSize, boxSize}*1.3, #1 + {boxSize, 
               boxSize}*1.3]}], 
         Rectangle[#1 - {boxSize, boxSize}, #1 + {boxSize, boxSize}], 
         Black, Text[#2, #1]}]] &)]

use grPltHigh[vertex list,edge list] or grPltHigh[] for pure graph

Usage with the result infor:

grPltHigh[{}, PathGraph[infor]]

I acctually hoped to use the custom property directly in calculations (e.g. setting EdgeWeight from it in FindShortestPath). Instead I have to use a filter function to derive different graphs for the according links "mail" or "meet".

(*This function filters the needed item per property*)
edgeFilter[inList_,filtProp_,filtItem_]:=Module[{inLst=inList,fltPrp=filtProp,fltIt=filtItem,ergLst},
ergLst=fltPrp/.#[[2]]&/@inLst(*Uses the List of Property for each edge to retrieve its value*);
Pick[inLst,ergLst,filtItem](*Gives only the edges that contain the item of property*)
];

Using it for getting a mail path between La and Ke:

gMail=Graph[edgeFilter[linkData,"interaction","mail"],VertexLabels->"Name"];
mailShort=FindShortestPath[gMail,"La","Ke"];
grPltHigh[{},PathGraph@mailShort]

It is done for "meet" pathes accordingly. To find the links between the groups one needs to setup a group graph. I have done it by replacing the vertex names with the group names and getting only the edges between different groups.

(*Derive a list of replacement for the vertex with its group*)
replRuleGroup=Flatten[{#[[1]]->#[[2,2]]}&/@vertexData];
(*Replace the vertex name by the group name*)
groupData=linkData/.replRuleGroup;
(*Pick only links that go from one group to the other*)
interGroup=Not[#[[ 1, 1]]==#[[1, 2]]]&/@groupData;
groupLink=Pick[groupData,interGroup,True]

In this case the result is the two edges from K group to L group.

{Property[ "L" <-> "K", {EdgeLabels -> "meet", EdgeStyle -> RGBColor[0, 1, 0], "interaction" -> "meet"}], Property["L" <-> "K", {EdgeLabels -> "mail", EdgeStyle -> RGBColor[0, 0, 1], "interaction" -> "mail"}]}

In the end it was way more complicated than assumed. The "custom property" in Property would be more usefull if it could be used in graph related functions as a filter property e.g. for EgdeCost, EdgeWeight, EdgeCapacity. I did played around with it a lot but ended up with nothing better than this long solution above. Quite disappointing. I really would like to know how to make proper use of "custom property" in Property.

Answer 3

Regarding the representation of a multigraph you can have a look at this question: How can I display a multigraph with different colored edges?.

Finding out which nodes are reachable you can use FindPath and FindShortestPath.