1
$\begingroup$

Consider a list (coordpairs) of coordinate pairs as

np = 4;
coordpairs = Cases[Subsets[Tuples[Range[np],{2}],{2}], {{a_, b_}, {c_, d_}} /; 
                   Abs[c - a] < 2 && Abs[d - b] < 2];

and their corresponding connectivities (conn) as

Edit 2: (corrected connectivity)

conn = {1., 1., 0., 1., 0., 1., 1., 1., 0., 1., 1., 0., 1., 0., 1., 0., 1.,
        0., 1., 1., 0., 1., 1., 0., 0., 0., 0., 0., 0., 1., 0., 0., 0., 0., 
        0., 0., 0., 0., 1., 1., 1., 1.};

1 indicates that there exists a path between the two points and 0 otherwise.

Now I wish to find all the paths (specifically, the coordinates of the points through the paths). For example, the first group will consist of the coordinates

{{1, 1}, {1, 2}, {2, 1}, {1, 3}, {2, 2}, {2, 3}, {1, 4}, {2, 4}, {3, 1}, {3, 2}, {3, 3}}

Second group:

{{3, 4}, {4, 4}, {4, 3}, {4, 2}, {4, 1}}

Edit 1 These two groups are visualized in the image below:

enter image description here

How can I do this?

Edit 3:(for higher np values)

Both the answers work well for np = 4. However, for np = 8

I have,

Length@coordpairs = 210;

conn = {0., 1., 1., 0., 0., 0., 0., 1., 0., 1., 1., 1., 0., 1., 1., 1., 0., 1., 1., 1., 1., 1., 0., 1., 1., 0., 0., 1., 1., 1., 1., 1., 0., 1., 0., 0., 0., 0., 0., 0., 0., 1., 0., 0., 1., 0., 0., 1., 0., 0., 1., 0., 1., 0., 1., 1., 1., 1., 1., 1., 1., 0., 1., 1., 0., 0., 0., 0., 0., 0., 0., 1., 1., 0., 0., 0., 1., 0., 0., 0., 0., 1., 0., 1., 1., 1., 1., 1., 1., 1., 0., 1., 1., 0., 1., 0., 1., 0., 1., 1., 1., 1., 0., 1., 1., 0., 0., 0., 1., 0., 1., 0., 1., 1., 1., 1., 1., 1., 1., 0., 1., 1., 0., 1., 0., 0., 1., 1., 0., 1., 1., 0., 1., 1., 0., 0., 0., 1., 0., 1., 0., 1., 1., 0., 1., 1., 1., 1., 0., 1., 1., 1., 0., 0., 0., 0., 1., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 1., 0., 0., 1., 1., 1., 0., 1., 1., 0., 0., 1., 0., 0., 0., 1., 0., 0., 0., 1., 0., 0., 0., 1., 0., 0., 1., 0., 0., 0., 0., 0., 0., 0., 1., 1., 1., 1., 0., 1.};

Now

 comps = ConnectedComponents[
  UndirectedEdge @@@ Extract[coordpairs, Position[db, 1.]]];

gives me 4 connected components where

Length@comps[[1]] + Length@comps[[2]] + Length@comps[[3]] + 
 Length@comps[[4]]

results

62

while it should be 64. The two missing coordinates are

{{1, 2}, {6, 3}}

where is it going wrong?

$\endgroup$
  • 2
    $\begingroup$ Do you mean ConnectedComponents[UndirectedEdge @@@ Extract[coordpairs, Position[conn, 1.]]]? $\endgroup$ – Coolwater Apr 11 '18 at 19:12
  • $\begingroup$ @Coolwater No. It lists down all the coordinates. It does not group as I have mentioned. $\endgroup$ – Majis Apr 11 '18 at 19:20
  • $\begingroup$ I do not understand the question. "I wish to find all the paths." What is a "path"? The graph you describe looks like this and has one connected component. What do you mean by "group"? $\endgroup$ – Szabolcs Apr 11 '18 at 19:43
  • $\begingroup$ @Szabolcs Thanks for pointing out the mistake. I have corrected the connectivity list. $\endgroup$ – Majis Apr 12 '18 at 10:48
  • 1
    $\begingroup$ You get 62, because only the edges are passed to ConnectedComponents. There are two vertices with no connections which are themselves additional components. See Szabolcs' answer where a graph object is passed such that ConnectedComponents includes these. $\endgroup$ – Coolwater Apr 13 '18 at 8:34
3
$\begingroup$

I'm agree this comment. This is your graph as you say

g = Graph[MapThread[
    If[#2 == 1, UndirectedEdge @@ #, Nothing @@ #] &, {coordpairs, conn}]];
Graph[g, VertexCoordinates -> VertexList[g], VertexLabels -> "Name"]

I also think your graph just have one connected component. You can group those connected vertices by ConnectedComponents and ConnectedGraphComponents

$\endgroup$
  • $\begingroup$ Sorry for the mistake on my part. I have corrected the connectivity accordingly. $\endgroup$ – Majis Apr 12 '18 at 10:49
2
$\begingroup$

I would do it like this:

vertices = Union@Catenate[coordpairs];

edges = UndirectedEdge @@@ Pick[coordpairs, conn, 1.];

graph = Graph[vertices, edges, VertexCoordinates -> vertices, 
  VertexLabels -> Automatic]

Mathematica graphics

ConnectedComponents[graph]
(* {{{3, 2}, {2, 2}, {2, 3}, {3, 3}, {1, 2}, {1, 3}, {1, 1}, {1,
    4}, {2, 4}, {2, 1}, {3, 1}}, {{3, 4}, {4, 4}, {4, 3}, {4, 2}, {4, 
   1}}} *)
$\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.