Finding corresponding vertex from 3d to 2d

Question

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?

Answer 1

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} *)