Vtgyjfy

I have the following set of 2d data points:

data1=

{

{21.557, 801.607}, {5.84689, 800.425}, {50.9284, 770.49}, 

{46.4516, 750.192}, {32.9808, 671.931}, {48.8067, 673.198}, 

{3.59394, 671.167}, {18.1513, 671.949}, {64.1628, 670.801}, 

{13.1805, 652.588}, {55.6619, 651.298}, {26.9262, 650.35}, 

{41.4876, 650.752}, {5.45129, 635.602}, {20.3858, 633.391}, 

{64.1931, 632.506}, {33.9168, 631.006}, {58.7559, 613.401}, 

{36.0045, 612.007}, {23.5348, 608.289}, {54.6781, 598.251}, 

{26.4914, 548.723}, {65.0549, 531.442}, {82.9996, 514.631}, 

{74.4132, 479.425}, {58.3295, 458.015}, {27.1816, 413.334}

}

I want to apply ScalingTransform, TranslationTransform and RotationTransform to find the best fit to transform data1 into data2, whereby:

data2=

{

{1530.03, 790.2}, {1514.13, 789.}, {1559.17, 758.9}, 

{1554.5, 738.5}, {1540.5, 660.237}, {1556.15, 661.154}, 

{1511.34, 659.395}, {1525.63, 660.167}, {1572.13, 658.656}, 

{1520.66, 640.844}, {1562.55, 639.132}, {1533.79, 638.607},     

{1548.37, 638.933}, {1512.62, 623.985}, {1526.88, 621.69},   

{1571.44, 620.556}, {1540.44, 618.794}, {1565.69, 601.532}, 

{1543.06, 600.093}, {1530.22, 596.423}, {1560.9, 586.053}, 

{1532.93, 536.587}, {1571.9, 519.25}, {1590.15, 501.882}, 

{1580.39, 467.111}, {1564.73, 445.615}, {1532.8, 400.935}

}

The corresponding points of data1 that should be transformed into data2 are already sorted and at the same position of the lists.

Here are plots of the two data sets:

plot1 = ListPlot[data1, PlotRange -> {{1, 91}, {300, 900}}, 

   PlotStyle -> Red, Frame -> True, 

   FrameLabel -> {{"y", ""}, {"x", "data1"}}, 

   BaseStyle -> {FontWeight -> "Bold", FontSize -> 15, 

     FontFamily -> "Calibri"}, ImageSize -> Large];



plot2 = ListPlot[data2, PlotRange -> {{1510, 1600}, {300, 900}}, 

   PlotStyle -> Blue, Frame -> True, 

   FrameLabel -> {{"y", ""}, {"x", "data2"}}, 

   BaseStyle -> {FontWeight -> "Bold", FontSize -> 15, 

     FontFamily -> "Calibri"}, ImageSize -> Large];



GraphicsColumn[{plot1, plot2}, ImageSize -> Large, 

 Spacings -> {{0, 0}, {0, 50}}]

I use the following naming:

s = ScalingTransform[{sx, sy}, {psx, psy}];

t = TranslationTransform[{vecx, vecy}];

r = RotationTransform[theta, {prx, pry}];

The combined transformation for each point {x, y} of data1 is:

combinedTransformation = s.t.r;

and finally :

combinedTransformation[{x, y}] =



{sx (prx (-Cos[theta]) + prx + pry Sin[theta]) + psx (-sx) + psx + 

  sx x Cos[theta] - sx y Sin[theta] + sx vecx, 

 sy (-(prx Sin[theta]) + pry (-Cos[theta]) + pry) + psy (-sy) + psy + 

  sy x Sin[theta] + sy y Cos[theta] + sy vecy}

The fitting parameters are: sx, sy, vecx, vecy, theta.

The scaling is centered at the point {psx, psy} and the 2d rotation is around the point {prx, pry}.

I would set {psx, psy} = {1, 1} and {prx, pry} = {1, 1}.

How can I transform data1 best into data2 and how can I obtain the fitting paramaters and their errors?

ADDENDUM:

I already tried the same as what is proposed below by Ulrich Neumann and Carl Lange.

• The problem with FindGeometricTransform is, it is not described how the error is obtained - I need this for a paper. See this question.




• Second FindGeometricTransform does not give me the rotation angle and scaling factor in x and y separately, which are not exactly the same.
  FindGeometricTransform shows only the transformation function (or matrix) which is not enough for me.

Try FindGeometricTransform

trafo = FindGeometricTransform[data2, data1 ];

F = TransformationMatrix[trafo[[2]]]

F[[{1, 2}, 3]] is the offset. Matrix

T= F[[{1, 2}, {1,2}]] 

describes rotation and scaling .

S = MatrixPower[ Transpose[T].T , 1/2]  (* scaling matrix*)

(*{{0.970832, -0.00629071}, {-0.00629071, 1.00107}}*)

R = Inverse[Transpose[T]].S             (* rotation matrix *)

(*{{0.999918, 0.0128058}, {-0.0128058, 0.999918}}*)

T - R.S // Chop                         (*T==R.S*)

The scaling factors are given by the eigenvalues of S.
The rotation angle can be obtained by

J = #.# &[Flatten[RotationMatrix[[CurlyPhi]] - R]];

NMinimize[{J, 0 <= [CurlyPhi] <= 2 Pi  }, [CurlyPhi]]

(*{4.36514*10^-15, {[CurlyPhi] -> 6.27038}}*)

[CurlyPhi]/Degree /. %[[2]]  (* angle in degree*)

(*359.266*)

Per Ulrich Neumann's comment, FindGeometricTransform will do the job very nicely.

We get the transform by doing

transform = FindGeometricTransform[data2, data1][[2]]

This gives us a TransformationFunction, in this case:

$$
text{TransformationFunction}left[left(
begin{array}{ccc}
0.970671 & 0.00652924 & 1502.57 \
-0.0187224 & 1.00107 & -12.4938 \
-0.0000212516 & -text{2.8535460791719293$grave{ }$*${}^{wedge}$-7} & 1. \
end{array}
right)right]
$$

Now we can apply that TransformationFunction to our data and plot the result:

ListPlot[{transform@data1, data2}]

First change the function combinedTransformation to

combinedTransformation[{x_, y_}] = 

{sx (prx (-Cos[theta]) + prx + pry Sin[theta]) + psx (-sx) + psx + 

sx x Cos[theta] - sx y Sin[theta] + sx vecx, 

sy (-(prx Sin[theta]) + pry (-Cos[theta]) + pry) + psy (-sy) + psy + 

sy x Sin[theta] + sy y Cos[theta] + sy vecy}

and then try

v   = Map[combinedTransformation, data1] - data2;

err = Sum[v[[k]].v[[k]], {k, 1, Length[v]}];

sol = NMinimize[err, {prx, pry, psx, psy, sx, sy, vecx, vecy, x, y, theta}]

and the result

The plot was produced as

plot1 = ListPlot[Map[combinedTransformation, data1] /. sol[[2]], 

PlotStyle -> Red, Frame -> True, 

FrameLabel -> {{"y", ""}, {"x", "data1 and data2"}}, 

BaseStyle -> {FontWeight -> "Bold", FontSize -> 15, 

FontFamily -> "Calibri"}, ImageSize -> Large]



plot2 = ListPlot[data2, PlotStyle -> Blue, Frame -> True, 

FrameLabel -> {{"y", ""}, {"x", "data1 and data2"}}, 

BaseStyle -> {FontWeight -> "Bold", FontSize -> 15, 

FontFamily -> "Calibri"}, ImageSize -> Large]



Show[plot1, plot2]