3
$\begingroup$

I'm trying to write a subroutine of a more complex function that confirms the existence of path, True or False, of any length, between two groups of vertices. The original data was produced by the shiny new 12.1 function MeshConnectivityGraph which worked great compared to previous custom implementations of this behaviour I found online. The function next starts to remove vertices (polygons) to optimize certain features but I need to ensure n paths still exist between the two groups.

Orange "highv" Start

{{2, 1}, {2, 2}, {2, 3}, {2, 4}, {2, 5}, {2, 6}, {2, 7}, {2, 8}, {2, 
  9}, {2, 10}, {2, 12}, {2, 14}, {2, 15}, {2, 17}}

Blue "lowv" Finish

{{2, 121}, {2, 369}, {2, 380}, {2, 381}, {2, 382}, {2, 383}, {2, 
  384}, {2, 385}, {2, 386}, {2, 387}, {2, 388}, {2, 389}, {2, 
  390}, {2, 392}}

As I worked my way through learning FindPath and the associated Graph guides, I haven't found a better way to finding a path exists other than permuting through the nodes but this is computationally intensive and distorts the resulting geometry. I don't know my way around all the capabilities of Mathematica's catalogue of graphing functions and am wondering if I am missing something? How would other people implement this behaviour?

enter image description here

style = MapThread[Rule, {lowV, Table[Blue, Length@lowV]}] ~ Join ~ 
   MapThread[Rule, {highV, Table[Orange, Length@highV]}];

graphA = MeshConnectivityGraph[geometry, {2, 2}, 1];
path = FindPath[graphA, {2, 1}, {2, 121}, {25, 35}, 1];

var = MapThread[
   UndirectedEdge[#1, #2] &,
   Transpose[Partition[path[[1]], 2, 1]]
   ];
pathstyle = MapThread[
   Rule,
   {var,
    Table[{Orange, AbsoluteThickness[5]}, Length@var]}
   ];
MeshConnectivityGraph[geometry, {2, 2}, 1,
  VertexStyle -> style,
  VertexSize -> 1.3,
  EdgeStyle -> pathstyle
  ]
$\endgroup$
  • 1
    $\begingroup$ If you really need "function that confirms the existence of path, True or False, of any length, between two groups of vertices" then your title "Find path between two groups of Vertices" is a bit misleading as this things are not the same. You should edit your title if that is the case. I gave you a solution based on the first quoted sentence here. $\endgroup$ – Vitaliy Kaurov Apr 27 at 0:26
  • 1
    $\begingroup$ (1) The code here appears to be incomplete (no geometry definition). (2) Check VertexContract ref guide page. $\endgroup$ – Daniel Lichtblau Apr 27 at 13:59
  • $\begingroup$ "The original data was produced by the shiny new 12.1 function MeshConnectivityGraph which worked great compared to previous custom implementations of this behaviour I found online." I hope you do not mean the implementation in IGraph/M, which works all the way back to version 10.0, and is very well tested? If you find an issue in a package, you should report it. $\endgroup$ – Szabolcs Apr 27 at 14:43
3
$\begingroup$

There is a caveat in this problem not explicitly mentioned. My assumption is that any "groups of vertices" checked for a path to other "groups of vertices" is itself internally connected i.e. belongs to a connected graph component.

Final function pathQ

I think what you really need is ConnectedComponents. Your code might look like something like this:

test[graph_,set_]:=Select[ConnectedComponents[graph],ContainsAll[#,set]&]

pathQ[graph_,set1_,set2_]:=
If[
    test[graph,set1]==={}||test[graph,set2]==={},
    "disconnected",
    test[graph,set1]===test[graph,set2]
]

Explanation

Imagine you got a graph (for the sake of an example - not a mesh, but some general graph):

g=NearestNeighborGraph[RandomInteger[99,100],{All,3},VertexLabels->Automatic]

enter image description here

And the following sets of points:

set1={41,42,43};
set2={41,42,64};
set3={17,18,19};
set4={59,51,52};

Let's define a test function

test[graph_,set_]:=Select[ConnectedComponents[graph],ContainsAll[#,set]&]

First you need to check that all points in each set you are dealing with belong to at least one connected component:

set4 does belong

In[]:= test[g, set4]
Out[]= {{52,51,49,50,47}}

but set2 dos not

In[]:= test[g, set2]
Out[]= {}

Once you make sure points in each of your set belong to at least one connect component (so you do not get empty set in the check above), you now can check if for both sets this connected component is the same. If it is - there is obviously a path.

For set1 and set3 there is a path

In[]:= test[g,set1]===test[g,set3]
Out[]= True

but for the set1 and set4 there is no path:

In[]:= test[g,set1]===test[g,set4]
Out[]= False

And with the final function outlined at the beginning:

In[]:= pathQ[g,set1,set2]
Out[]= disconnected

In[]:= pathQ[g,set1,set3]
Out[]= True

In[]:= pathQ[g,set1,set4]
Out[]= False
| improve this answer | |
$\endgroup$
2
$\begingroup$

You can also use ConnectedMeshComponents to find connected components, without needing to convert to a graph first.

| improve this answer | |
$\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.