10
$\begingroup$

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?

$\endgroup$
0

1 Answer 1

13
$\begingroup$

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] 

vertices

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]]] 

graphs

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

animate

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

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.