Fitting C-shaped points with right-pointing parabola, ellipse, circle or other

Question

I was trying to fit the following points:

points = {{28.8729, 57.1427}, {28.8752, 57.1733}, {28.8784, 57.2011}, 
 {28.8815, 57.2283}, {28.8816, 57.1297}, {28.8858, 57.1148}, {28.8867, 
  57.2515}, {28.8859, 57.208}, {28.8926, 57.1102}, {28.894, 
  57.2801}, {28.8934, 57.2432}, {28.8991, 57.0976}, {28.9076, 
  57.1042}, {28.9108, 57.3016}, {28.9143, 57.1039}, {28.9135, 
  57.0916}, {28.9191, 57.0501}, {28.9193, 57.3147}, {28.9256, 
  57.0781}, {28.9276, 57.0447}, {28.9356, 57.0395}, {28.9392, 
  57.3384}, {28.9433, 57.0234}, {28.9508, 57.0259}, {28.9582, 
  57.3489}, {28.9621, 57.0147}, {28.9736, 57.0092}, {28.9771, 
  57.3778}, {28.9791, 56.9927}, {28.9913, 56.9889}, {28.9971, 
  57.4146}, {28.9994, 56.9892}, {29.0084, 56.9813}, {29.0108, 
  57.4304}, {29.0166, 56.9784}, {29.0233, 56.9603}, {29.0247, 
  56.9741}, {29.0341, 56.9741}, {29.0425, 56.98}, {29.0495, 
  56.9795}, {29.0581, 56.9782}, {29.0678, 56.9751}, {29.0751, 
  56.9879}, {29.0821, 57.0118}, {29.0915, 57.0134}, {29.1001, 
  57.0207}, {29.1071, 57.0237}, {29.1065, 57.009}};
ListPlot[points]

The objective is to reach a function that fits the points, something similar to this:

In my understanding, this looks like a right-pointing parabola:

So I tried this function, but it didn't work (the fit was inaccurate):

curveFit = Plot[57.01032231556321` + 
    4.524767722795246` *(-29.0814390274144`+x)^2,
   {x,28,29.33}, PlotStyle -> Orange]; 
Show[points, curveFit]

So I decided to try to fit an ellipse or circle instead, but I don't know how to do it in an automated way (maybe like a Monte Carlo simulation). So I drew an ellipse on top of the points:

h=29.01(*x-coordinate of the center*);
k=57.175(*y-coordinate of the center*);
a=0.13(*radius along the x-axis*);
b=0.2(*radius along the y-axis*);
ellipse=ParametricPlot[{h+a Cos[t], k+b Sin[t]},
  {t,0,2 Pi}, PlotRange->All, AxesLabel->{"x","y"},
  AxesOrigin -> {h-a, k-b}, PlotStyle->Orange]
    
Show[ellipse, points]

I hope anyone can guide me on the right way to proceed.

Answer 1

Here is approach based on this answer

Data provided:

data = {{28.8729, 57.1427}, {28.8752, 57.1733}, {28.8784, 
    57.2011}, {28.8815, 57.2283}, {28.8816, 57.1297}, {28.8858, 
    57.1148}, {28.8867, 57.2515}, {28.8859, 57.208}, {28.8926, 
    57.1102}, {28.894, 57.2801}, {28.8934, 57.2432}, {28.8991, 
    57.0976}, {28.9076, 57.1042}, {28.9108, 57.3016}, {28.9143, 
    57.1039}, {28.9135, 57.0916}, {28.9191, 57.0501}, {28.9193, 
    57.3147}, {28.9256, 57.0781}, {28.9276, 57.0447}, {28.9356, 
    57.0395}, {28.9392, 57.3384}, {28.9433, 57.0234}, {28.9508, 
    57.0259}, {28.9582, 57.3489}, {28.9621, 57.0147}, {28.9736, 
    57.0092}, {28.9771, 57.3778}, {28.9791, 56.9927}, {28.9913, 
    56.9889}, {28.9971, 57.4146}, {28.9994, 56.9892}, {29.0084, 
    56.9813}, {29.0108, 57.4304}, {29.0166, 56.9784}, {29.0233, 
    56.9603}, {29.0247, 56.9741}, {29.0341, 56.9741}, {29.0425, 
    56.98}, {29.0495, 56.9795}, {29.0581, 56.9782}, {29.0678, 
    56.9751}, {29.0751, 56.9879}, {29.0821, 57.0118}, {29.0915, 
    57.0134}, {29.1001, 57.0207}, {29.1071, 57.0237}, {29.1065, 
    57.009}};

Fitting ellipse:

ref = {#1^2, #1, #2, 2 #1 #2, #2^2} & @@@ data;
ell = LinearModelFit[ref, {1, a, b, c, d}, {a, b, c, d}]
ellipse[x_, y_] := 
 ell["BestFitParameters"] . {1, x^2, x, y, 2 x y} - y^2
ContourPlot[ellipse[x, y] == 0, {x, 28.5, 29.5}, {y, 56.9, 57.6}, 
 Epilog -> Point[data]]

The equation for ellipse: $1.87924 x^2-0.137714 x y-101.268 x+y^2-110.396 y+4627.53=0$

Answer 2

If the objective is to draw a relatively smooth curve through the points, then finding a "parametric" equation that predicts both the $X$ and $Y$ coordinate from a single predictor might be considered.

(* Divide the data into two parts *)
data1 = Select[data, #[[2]] > 57.15 &];
data2 = Select[data, #[[2]] <= 57.15 &];
ListPlot[{data1, data2}]

(* Now sort each part and join back together *)
data1 = Sort[data1, #1[[1]] > #2[[1]] &];
data2 = Sort[data2, #1[[1]] < #2[[1]] &];
data0 = Join[data1, data2];
ListPlot[data0, Joined -> True]

(* Fit both the x and y coordinates in "time" order *)
n = Length[data0];
lmx = LinearModelFit[data0[[All, 1]], {x, x^2, x^3, x^4}, x]
lmy = LinearModelFit[data0[[All, 2]], {y, y^2}, y]
f[t_] := {lmx[t], lmy[t]}
ListPlot[{data0, Table[f[t], {t, 1, n, 0.1}]}, 
 Joined -> {False, True}, PlotStyle -> PointSize[0.02], PlotRange -> All]

Now you have a function f[t] that will approximate the points where the predicted coordinates are found with a value of t from 1 to 48 (with 48 being the number of data points).

f[t]
(* {29.0452 - 0.028983 t + 0.00160732 t^2 - 0.0000303339 t^3 + 2.09131*10^-7 t^4,
    57.4545 - 0.024639 t + 0.000322699 t^2} *)

If the objective is to predict future data points, then describing the data generation process for the original and future data is necessary.

Answer 3

FYI, the reason your fit was "inaccurate" is that your data is not a function of x. Switch the x and y points and refit. You'll get something closer, but the data is also not a function of y.

rpoints = Transpose[{points[[All, 2]], points[[All, 1]]}]; 
curve = Fit[rpoints, {y^2, y, 1}, y]; 
Show[ListPlot[points], 
 ParametricPlot[{curve, y}, {y, 56, 58}, PlotStyle -> Orange]]