3
$\begingroup$

I need to visualize a graph spatially, and I'm simply using:

HighlightGraph[ConnectedGraphComponents[]]

and the known coordinates of the graph's nodes. I really like how it looks, but for large graphs, I'd like to delete those edges at the "boundaries" of the spatial domain (a square grid of known side length). By the method I generate the graphs, all edges are always 1 space unit of distance from other nodes, so they look good, but edges joining extreme nodes (still 1 unit in periodic boundary conditions) traverse the whole grid in the visualization, and it can look messy for large graphs.

If I could use the information of the grid size to omit the visualization of edges that join "boundary" nodes, that would be great. I just don't know where to start.

Here's a Dummy example of what I'm talking about:

(*Imagine the spatial domain is a square of side 4*)

(*Create the graph*)
DummyGraph = Graph[{a <-> b, c <-> d, e <-> f}];

(*Let's assume these are the coordinates of the {a,b,c,d,e,f} nodes*)
DummyCoordinates = {{1, 1}, {4, 1}, {2, 1}, {2, 4}, {3, 2}, {3, 3}};

(*Then we can get a nice "spatial" visualization of this graph*)
HighlightGraph[
 DummyGraph, ConnectedGraphComponents[DummyGraph],
 VertexCoordinates -> DummyCoordinates,
 VertexSize -> .85, VertexShapeFunction -> "RoundedSquare",
 VertexLabelStyle -> Directive[Bold, 25],
 VertexLabels -> "Name",
 Background -> "White"
 ]

enter image description here

Note that the edges joining a<->b and c<->d are long because they need to traverse the whole grid (in this dummy example the grid side is 4). What I'd like to preserve is their respective colors (because I need to distinguish them, as in ConnectedGraphComponents[]) but omit the drawing of this particular edges, while keeping all other edges (for instance, I'd like to keep f<->e).

I've thought of something like getting a list with all those edges that join two "boundary" nodes, and then somehow (in the options of EdgeShapeFunction[] perhaps?) make them "transparent" while keeping the information on ConnectedGraphComponents[] and the visualization of all the other edges. But haven't found options to omit specific subset of edges in the visualization using HighlightGraph[ConnectedGraphComponents[]]. I've also found this answer, and it might be useful, but in my case, all edges have the same weights, so I'm not sure if that process is directly applicable to my case.

Thanks in advance for any help/suggestion,

Pedro

Notes: 1) I don't want to delete those edges from the graph object (since HighlightGraph[] wouldn't work with ConnectedGraphComponents[] anymore, as a single component would be split into many, and thus the color visualization would change). This is just a visualization problem I'm trying to solve. 2) I've checked IGraph/M to see if there's something about this, but I couldn't find a clear direction. 3) Just to show why I want to avoid those "long edges", here's one of the visualizations in which those "long edges" go through many other ConnectedGraphComponents[].

enter image description here

EDIT 1: The answer below by @kglr is a great start, and I'll explore it further, but perhaps I wasn't clear in that I'd like to keep any other edge that does not traverse the whole grid. Using @kglr answer on large graphs, I see that any edge that belongs to a "boundary node" is removed, even when many of these edges would not traverse the whole grid. Here, for instance, I zoom in into nodes that should be joined by edges (i.e. they belong to the same GraphComponent) but are filtered out:

enter image description here

$\endgroup$
2
$\begingroup$

Here is a way to remove any edge that is longer than a certain distance in the embedding (g is your graph after applying HighlightGraph):

embeddingDistance[g_, UndirectedEdge[a_, b_]] := Module[{embedding, vertices},
  embedding = GraphEmbedding[g];
  vertices = VertexList[g];
  EuclideanDistance[a, b] /. Thread[vertices -> embedding]
  ]

toDelete = Select[EdgeList[g], embeddingDistance[g, #] >= 3 &];
EdgeDelete[g, toDelete]

Mathematica graphics

In this case, I specified the cut-off distance to be 3, which is the width of the box. This means that it will only remove edges that span the whole width or height. (Assuming there are no diagonal edges, it doesn't look like it.)

$\endgroup$
  • $\begingroup$ This is a nice, perhaps more general approach than what I was thinking of (and also it seems a bit faster than the previous answer). $\endgroup$ – TumbiSapichu Jul 15 '18 at 0:01
2
$\begingroup$

Update: To delete edges that traverse the grid vertically or horizontally:

ClearAll[longQ, longEdges, deleteLongEdges]
longQ[g_, e_] := Module[{vc = PropertyValue[{g, #}, VertexCoordinates] & /@ (List @@ e) , 
   pat = Alternatives @@ {Thread[{#, a_}], Thread[{Reverse@#, a_}] , 
        Thread[{a_, #2}], Thread[{a_, Reverse@#2}] } & @@ 
     CoordinateBounds[GraphEmbedding@g] }, MatchQ[vc, pat]]

longEdges[g_] := Pick[EdgeList[g], longQ[g, #] & /@ EdgeList[g]] 

deleteLongEdges[g_] := EdgeDelete[g, longEdges @ g] 

Examples:

Grid[{SetProperty[#, ImageSize -> 350] & /@ 
   {HighlightGraph[hg, Style[#, Thickness[.03]] & /@ longEdges[hg]] ,
     deleteLongEdges @ hg}}, Dividers -> All] 

enter image description here

g2 = Graph[{a <-> b, b <-> c, c <-> d, e <-> f}];
coords2 = {{1, 1}, {4, 1}, {2, 1}, {2, 3}, {3, 2}, {3, 3}};
hg2 = HighlightGraph[g2, ConnectedGraphComponents[g2], 
    VertexCoordinates -> coords2, VertexSize -> .85, 
    VertexShapeFunction -> "RoundedSquare", 
    VertexLabelStyle -> Directive[Bold, 25], VertexLabels -> "Name", 
    Background -> "White", ImageSize -> 350] ;

Grid[{{HighlightGraph[hg2, Style[#, Thickness[.03]] & /@ longEdges[hg2] ] , 
   deleteLongEdges @ hg2}}, Dividers -> All]

enter image description here

SeedRandom[777777]
rg = RandomGraph[{15, 10}, 
   VertexCoordinates -> GraphEmbedding[GridGraph[{3, 5}]]];
hgrg = HighlightGraph[rg, ConnectedGraphComponents[rg], 
   VertexSize -> .65, 
    VertexShapeFunction -> "RoundedSquare", 
    VertexLabelStyle -> Directive[Bold, 16], VertexLabels -> "Name", 
    Background -> "White", ImageSize -> 350 ];

Grid[{{ HighlightGraph[hgrg, Style[#, Thickness[.03]] & /@ longEdges[hgrg] ], 
   deleteLongEdges @ hgrg}}, Dividers -> All] 

enter image description here

Original answer:

toBeDeleted[g_, e_] := MemberQ[DeleteDuplicates @ Flatten @ 
   CoordinateBounds[GraphEmbedding @ g] ,
   Alternatives @@ (DeleteDuplicates @ Flatten[ 
      PropertyValue[{g, #}, VertexCoordinates] & /@ (List @@ e)])]

Example:

hg = HighlightGraph[DummyGraph, ConnectedGraphComponents[DummyGraph],
 VertexCoordinates -> DummyCoordinates,
 VertexSize -> .85, VertexShapeFunction -> "RoundedSquare",
 VertexLabelStyle -> Directive[Bold, 25],
 VertexLabels -> "Name",
 Background -> "White"];

EdgeDelete[hg, e_?(toBeDeleted[hg, #] &)]

enter image description here

$\endgroup$
  • $\begingroup$ That is a great start, and I'll try to adapt it to my case. I made an edit to my question, just to clarify a point that might not have been clear. Thanks!! $\endgroup$ – TumbiSapichu Jul 14 '18 at 23:31
  • $\begingroup$ @PedroSapichu, I will update with a fix. $\endgroup$ – kglr Jul 14 '18 at 23:34
  • $\begingroup$ That's just what I needed @kglr. I'm trying to follow the logic of your code, can you comment a bit on what's the reasoning behind toBeDeleted2[g_, e_]? Thanks! $\endgroup$ – TumbiSapichu Jul 14 '18 at 23:56

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.