0
$\begingroup$

Goodmorning,

I mean to this link: Find polynomial equation for set of 3D data

I tried to verify the result, namely if the interpolation is correct, but I found something that I don't understand.

I rewrite the code used:

points = {{144, 18, 52}, {142, 24, 40}, {124, 12, 40}, {64, 30, 48}, {96, 30, 
32}, {74, 26, 56}, {136, 26, 24}, {54, 22, 64}, {92, 22, 16}, {96, 14, 
64}, {92, 10, 56}, {82, 10, 24}, {76, 6, 48}, {68, 6, 32}};

fit == ((lmf = 
     LinearModelFit[
      RotateRight /@ points, {x, z, x^2, z^2, x*z}, {x, z}]) // 
   Normal)

I don't find the correct solution. I done this to evaluate the results, I took from the first element {144, 18, 52}:

x0 = 144;
z0 = 52;

lmf[x0, z0]

and I get this:

62.0327

I expected this: y = 18

Help, please! Thank you!

$\endgroup$
  • 1
    $\begingroup$ RotateRight /@ points puts your coordinates in the order {z, x, y}, not {x, z, y}. Either adjust your usage or use points[[All, {1, 3, 2}]]. Then lmf[x0, z0] will be 15.27. You shouldn't expect to get 18, since you cannot interpolate so many points with such a model. $\endgroup$ – Michael E2 Jun 3 '18 at 18:20
  • $\begingroup$ @MichaelE2 ok, thank you, but there is a method to well interpolate these many points? $\endgroup$ – user8011311 Jun 3 '18 at 18:31
3
$\begingroup$

Interpolation will interpolate, if the points are well-poised:

if = Interpolation[points[[All, {1, 3, 2}]], InterpolationOrder -> All];
Show[
 Plot3D[if[x, z], {x, z} ∈ ConvexHullMesh@points[[All, {1, 3}]], PlotRange -> All],
 Graphics3D[{
   Red, Sphere /@ points[[All, {1, 3, 2}]]
   }]
 ]

Mathematica graphics

$\endgroup$
  • $\begingroup$ Now, how to get the mathematical function? I tried to use {Normal[if]} 'code' , but no answer. Thank you to all. $\endgroup$ – user8011311 Jun 4 '18 at 7:48
  • $\begingroup$ I tried to adapt the points by increasing the order of the interpolation function, following @HenrikSchumacher 's example. But, there is an automatic method? $\endgroup$ – user8011311 Jun 4 '18 at 8:06
  • $\begingroup$ Sorry, but I don't understand the last code don't work for me. I get this: [code] InterpolatingPolynomial::ipab: Abscissa specification 144 in {144,52,18} is not a point in 2 dimensions. >> $\endgroup$ – user8011311 Jun 4 '18 at 12:27
  • $\begingroup$ @user8011311 Maybe InterpolatingPolynomial[{#[[{1, 3}]], #[[2]]} & /@ points, {x, z}]? I'm not on M at the moment and I forgot the syntax was different. $\endgroup$ – Michael E2 Jun 4 '18 at 12:30
  • $\begingroup$ ok, this give me a results, but in fraction format, and for see in the number coefficients? $\endgroup$ – user8011311 Jun 4 '18 at 12:40
2
$\begingroup$

Well, you have 14 points, hence 14 equations, so you also need at least 14 parameters for an exact fit. If you really want to have an exact fit, you have to include more variables into your model. For example, you could use all polynomials of order 4 or less:

points = {{144, 18, 52}, {142, 24, 40}, {124, 12, 40}, {64, 30, 
    48}, {96, 30, 32}, {74, 26, 56}, {136, 26, 24}, {54, 22, 64}, {92,
     22, 16}, {96, 14, 64}, {92, 10, 56}, {82, 10, 24}, {76, 6, 
    48}, {68, 6, 32}};
pts = points[[All, {1, 3, 2}]];
model = Rest[Flatten[Table[x^i y^j, {i, 0, 4}, {j, 0, 4 - i}]]];
lmf = LinearModelFit[
   pts,
   Flatten[Table[x^i y^j, {i, 0, 4}, {j, 0, 4 - i}]],
   {x, y}
   ];
fit = Normal[lmf]
Show[
 Graphics3D[Sphere[#, 2] & /@ pts],
 Plot3D[
  fit, {x, Sequence @@ MinMax[pts[[All, 1]]]}, {y, 
   Sequence @@ MinMax[pts[[All, 2]]]}
  ],
 Lighting -> "Neutral"
 ]

enter image description here

But note that this model has more than 14 parameters, so there are multiple solutions! (And Mathematica tells you so via a warning message.)

If the points are statistical data, it is really bad practice to use that many parameters (it leads to overfitting).

$\endgroup$

Not the answer you're looking for? Browse other questions tagged or ask your own question.