# Finding corresponding vertex from 3d to 2d

I have this simple 3d data points:

v = {{0., 0.016821, -0.5}, {0.353553, -0.75, -0.353553}, {0., -0.75, -0.5},
{0.353553,  -0.013361, -0.353553}, {0.5, -0.75,
0.}, {0.5, -0.020719, 0.}, {0.353553, -0.020719,
0.353553}, {0.353553, -0.75, 0.353553}, {0., -0.020719,
0.5}, {0., -0.75, 0.5}, {-0.353553, -0.020719,
0.353553}, {-0.353553, -0.75, 0.353553}, {-0.5, -0.020719,
0.}, {-0.5, -0.75, 0.}, {-0.353553, -0.043838, -0.353553}, {-0.353553,
-0.75, -0.353553}};


and

 polys = {{2, 3, 4}, {4, 3, 1}, {5, 2, 6}, {2, 4, 6}, {8, 5, 6}, {6, 7, 8},
{10, 8,  7}, {7, 9, 10}, {12, 10, 9}, {9, 11, 12}, {14, 12,
11}, {11, 13, 14}, {1, 3, 15}, {15, 3, 16}, {14, 13, 15}, {16, 14, 15}};


Same data, in 2d representation: following are 2d points

 uv = {{0.2505, 0.500001}, {0.2505, 0.624988}, {0.009907,
0.500001}, {0.00005, 0.624988}, {0.2505,
0.375013}, {0.012311, 0.375013}, {0.2505,
0.250026}, {0.012311, 0.250025}, {0.2505,
0.125038}, {0.012311, 0.125038}, {0.2505,
0.00005}, {0.012311, 0.00005}, {0.2505, 0.874962}, {0.2505,
0.99995}, {0.012312, 0.99995}, {0.012312,
0.874963}, {0.019862, 0.749975}, {0.2505, 0.749975}};


and

 npolys = {{1, 2, 3}, {3, 2, 4}, {5, 1, 6}, {1, 3, 6}, {7, 5, 6}, {6,
8, 7}, {9, 7, 8}, {8, 10, 9}, {11, 9, 10}, {10, 12, 11}, {13, 14,
15}, {15, 16, 13}, {4, 2, 17}, {17, 2, 18}, {13, 16, 17}, {18, 13, 17}};


I am trying to find corresponding vertex order from 3d to 2d. Coordinates are different in both 3d and 2d view. is it possible to do in mathematica?

We could do this with graph theory. Let's turn the polygon structure into a graph:

g3 = Graph[UndirectedEdge @@@ Union[Sort /@
Flatten[polys /. {a_, b_, c_} :> {{a, b}, {b, c}, {c, a}}, 1]]]


This creates a graph edge for each edge of each triangle, then filters it down to unique edges.

For the 2D we need to first join the ends. Let's visually see which one is which:

Graphics[Text[#2, Reverse@#1] &~MapIndexed~uv]


We can now identify some vertices and make another graph:

npolyswrap = npolys /. {12 -> 15, 11 -> 14};

g2 = Graph[UndirectedEdge @@@ Union[Sort /@
Flatten[npolyswrap /. {a_, b_, c_} :> {{a, b}, {b, c}, {c, a}}, 1]]]


Now find a mapping between the two graphs:

FindGraphIsomorphism[g2, g3]

(* {1 -> 2, 2 -> 3, 3 -> 4, 5 -> 5, 6 -> 6, 4 -> 1, 17 -> 15, 18 -> 16, 7 -> 8, 8 -> 7,
9 -> 10, 10 -> 9, 14 -> 12, 15 -> 11, 13 -> 14, 16 -> 13} *)


• LOL - Could be a hit even on YouTube :)
– eldo
Commented Jul 3, 2014 at 20:53
• +1 btw the First@# \[UndirectedEdge] Last@# & /@ bit could be replaced by UndirectedEdge @@@.
– Aky
Commented Jul 4, 2014 at 0:58
• @Aky Good point. Makes it look a bit nicer. Commented Jul 4, 2014 at 4:39
• The gif is hurting my brain! p.s. very nice solution :)
– Kuba
Commented Jul 4, 2014 at 4:56