Message Boards Message Boards

0
|
2905 Views
|
3 Replies
|
2 Total Likes
View groups...
Share
Share this post:

Finding the possible rotations of set of 3D points?

Posted 7 years ago

Hi,

I have two sets of 3D points. I want rotate data2 while keeping data1 constant. And I want to find out what are all the possible rotations data2 can have while keeping its geometry horizontal and parallel to data1 (i.e. facing each other). Can you help me to accomplish that? TIA

data1 = {{-0.76605542, -0.17686675, -0.82332146},
   {-1.45292042, -1.37163375, -0.66183746},
   {-2.86933942, -1.22490575, -0.71900646},
   {-3.26481042, 0.07793225, -0.92173846},
   {-1.90144942, 1.14801825, -1.06179046},
   { 0.66067858 , 0.06673325, -0.82324246},
    {1.34752258 , 1.26152125, -0.66182246},
    {1.79610558, -1.25817975, -1.06139746},
    {2.76394858 , 1.11478725, -0.71878046},
    {3.15944758, -0.18807775, -0.92128646}};


data2 = {{-0.52739887, 0.07259519, 3.16175217},
   {-1.21426387, -1.12217181 , 3.32323617},
   {-2.63068287, -0.97544381 , 3.26606717},
   {-3.02615387, 0.32739419 , 3.06333517},
   {-1.66279287, 1.39748019, 2.92328317},
   { 0.89933513 , 0.31619519 , 3.16183117},
   { 1.58617913, 1.51098319, 3.32325117},
   { 2.03476213, -1.00871781 , 2.92367617},
   { 3.00260513, 1.36424919 , 3.26629317},
   { 3.39810413, 0.06138419 , 3.06378717}};


Show[ListPointPlot3D[{data1, data2}, 
  PlotStyle -> {Directive[PointSize[Large], Red], 
    Directive[PointSize[Large], Green]}], SphericalRegion -> True, 
 BoxRatios -> 1, PlotRange -> 4, ImageSize -> 500]

enter image description here

 rot1data2 = RotationTransform[Pi, {1, 0, 0}][data2];

Show[ListPointPlot3D[{data1, rot1data2}, 
  PlotStyle -> {Directive[PointSize[Large], Red], 
    Directive[PointSize[Large], Green]}], SphericalRegion -> True, 
 BoxRatios -> 1, PlotRange -> 4, ImageSize -> 500]


rot2data2 = RotationTransform[Pi, {0, 1, 0}][data2];


Show[ListPointPlot3D[{data1, rot2data2}, 
  PlotStyle -> {Directive[PointSize[Large], Red], 
    Directive[PointSize[Large], Green]}], SphericalRegion -> True, 
 BoxRatios -> 1, PlotRange -> 4, ImageSize -> 500]
POSTED BY: SAMM Hill
3 Replies

Hi, I am not sure whether I understand your problem correctly, but maybe you need Nearest. The idea is simple:

Manipulate[
 rdata2 = RotationTransform[\[Phi], {0, 0, 1}][data2];
 Graphics3D[{PointSize[.03], Red, Point[data1], Green, Point[rdata2],
   Black, Line[{#, First@Nearest[rdata2, #]} & /@ data1]}, 
  PlotRange -> {{-4, 4}, {-4, 4}, Automatic}], {\[Phi], 0, 2 Pi}]

giving:

enter image description here

So if all those Nearest-distances are summed up:

totalDist[\[Phi]_] := 
 Total[EuclideanDistance @@@ ({#, 
       First@Nearest[
         RotationTransform[\[Phi], {0, 0, 1}][data2], #]} & /@ data1)]

one has a function to be minimized:

enter image description here

Hope that helps, regards -- Henrik

POSTED BY: Henrik Schachner

Manipulate may help:

Manipulate[
 Show[ListPointPlot3D[{data1, RotationTransform[t, {a, b, c}][data2]},
    PlotStyle -> {Directive[PointSize[Large], Red], 
     Directive[PointSize[Large], Green]}], SphericalRegion -> True, 
  BoxRatios -> 1, PlotRange -> 4, ImageSize -> 500],
 {t, 0, 2 Pi}, {{a, 1}, -1, 1}, {{b, 0}, -1, 1}, {{c, 0}, -1, 1}]
POSTED BY: Gianluca Gorni

Manipulate may help:

Manipulate[
 Show[ListPointPlot3D[{data1, RotationTransform[t, {a, b, c}][data2]},
    PlotStyle -> {Directive[PointSize[Large], Red], 
     Directive[PointSize[Large], Green]}], SphericalRegion -> True, 
  BoxRatios -> 1, PlotRange -> 4, ImageSize -> 500],
 {t, 0, 2 Pi}, {{a, 1}, -1, 1}, {{b, 0}, -1, 1}, {{c, 0}, -1, 1}]
POSTED BY: Gianluca Gorni
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract