How to make some mess points to be more smooth?

Question

Background:

The question is derive form this post.I have a another thinking about it.Some points in a suface you can give a certain equation but some points you cannot.So I wanna get a method to process that no equation case. Something method like signal filtering.It should be more smoother then before. As this meanning,but these points in 1D:

So I make some pseudo-data like following.Can we donn't use equation of circle(like fitting a circle) to process messPoint2D?

SeedRandom[322]
point2D = RandomPoint[Circle[{0, 0}, 2], 50];
messPoint2D = point2D /. a_Real :> a + RandomReal[{-.3, .3}]

{{2.03482,-0.0505514},{-2.12001,-0.817728},{-1.74035,-1.63313},{1.78539,-1.13954},{1.89574,0.558508},{-0.768103,1.96266},{1.9696,-0.234131},{1.33527,1.72081},{-1.34696,1.11191},{1.70215,-0.457756},{1.49434,-1.4612},{-0.827573,1.96794},{1.68644,-0.589807},{0.0611676,-1.77899},{0.751324,-1.77146},{-1.14019,-1.784},{1.87253,0.479152},{1.66679,-1.33623},{-1.93342,0.640445},{1.69974,-0.807108},{2.0371,-0.0763891},{-1.43967,1.73074},{-1.66722,0.433916},{1.56104,-1.16691},{1.59916,1.19086},{0.772323,-1.86247},{-1.89905,-0.775599},{-0.73034,2.12354},{-2.02256,0.366491},{-1.06331,-1.7122},{0.331255,-2.01548},{-1.69992,-0.419732},{-0.199849,1.77909},{2.13569,0.986909},{1.7007,-1.43682},{-2.02245,-0.394945},{1.84753,-1.0587},{-1.79648,-0.260515},{1.5658,1.64252},{-2.08078,0.917446},{2.20509,0.134297},{0.00486855,-1.80853},{-1.95518,0.0733502},{1.21364,1.50024},{0.558922,2.21009},{2.13153,-0.130213},{-1.51461,-1.57134},{-1.92186,0.354744},{1.69165,-0.971832},{-0.848805,-1.48607}}

Let's visualize it

Graphics[Point[messPoint2D]]

It's too rough.So I try to smooth it

smoothPoint2D = 
  Catenate[MeanFilter[#[[Most@Last@FindShortestTour[#]]], {3, 0}] & /@
     GatherBy[messPoint2D, Last[#] < 0 &]];

Show it in a graphics

Graphics@Point[smoothPoint2D]

We have a bad try obviously.Furthermore if the points is in a ellipse,the MeanFilter will give a worse result.Such the points like this:

SeedRandom[322]
point3D = 
  RandomPoint[
   RegionBoundary@DiscretizeRegion@Ellipsoid[{0, 0, 0}, {4, 3, 2}], 
   50];
messPoint3D = point3D /. a_Real :> a + RandomReal[{-.3, .3}]

{{2.07207,-1.74115,0.99079},{-1.00152,-1.87601,1.44575},{0.614248,-3.15193,0.669161},{0.506019,1.6797,-1.26587},{-0.697259,1.68684,-1.38891},{-2.7229,-1.45861,-0.980062},{-1.91229,-0.597374,1.64356},{-2.63553,-1.40528,1.21356},{-3.54036,-0.964002,-0.683493},{0.113757,-2.12893,-1.32791},{0.365527,2.21043,1.4537},{-1.79497,-1.96956,1.46747},{2.61934,-0.640953,-1.57529},{3.68277,-0.163062,0.119088},{-1.10108,2.63133,0.77401},{1.0603,1.02331,1.918},{3.45375,-0.375101,-0.600496},{0.854518,-1.56796,-1.63765},{1.37402,0.0916543,-1.62574},{-2.26586,-2.1045,-0.618894},{2.20182,-2.27725,0.736805},{-0.877823,1.18774,-1.77738},{-1.50583,-2.50576,0.317816},{2.70735,-1.74998,1.10437},{2.66755,-1.23068,-0.69978},{3.2197,-1.6254,0.309938},{-0.891931,2.87209,0.836711},{-1.52483,-1.17109,1.74934},{0.301247,3.06736,0.0764326},{-2.147,2.43088,0.240942},{3.79116,0.333534,0.0275468},{-0.174168,3.11093,-0.388287},{-2.42676,-0.934665,-1.50067},{-3.6411,0.668195,-0.675299},{-2.68546,0.159208,1.4389},{1.13681,-3.06672,0.120309},{-1.63009,-2.20641,-0.81025},{-4.06233,0.572647,-0.447319},{-3.23295,-0.715793,1.32005},{2.32172,2.72233,-0.162109},{-4.04731,-0.301951,-0.389709},{1.51613,-2.88289,-0.325647},{-2.66844,1.89623,0.86255},{-0.185447,2.58316,0.785376},{3.4009,-0.0871182,0.966895},{1.89572,2.42516,-0.430788},{1.89118,1.7872,1.40493},{1.77714,2.7319,0.544681},{0.061336,1.74055,-1.41376},{3.72806,-0.487459,-0.0564766}}

Graphics3D[Point[messPoint3D]]

So how to make this rough points in a surfaces to be like more smooth?

Answer 1

fst = FindShortestTour[mess];
Show[ListPlot[mess, PlotStyle -> {PointSize[Large], Red}], 
     ParametricPlot[ BSplineFunction[mess[[Last@fst]], SplineClosed -> True][t], 
                    {t, 0, 1}]]

Answer 2

As the @Alexey Popkov's suggestion that avoid the question to so long.I post some progress as a answer:

As the @Dr. belisarius's version 9.0 have no RegionNearest,So I update current progress in here(Every credit should be took by Dr. belisarius).The 2D point can be like this:

bezierCurve = 
  Graphics@BezierCurve[
    messPoint2D[[Last@FindShortestTour[messPoint2D]]], 
    SplineClosed -> True];
targetPoint2D = 
  RegionNearest[DiscretizeGraphics@bezierCurve, #] & /@ messPoint2D;
Show[bezierCurve, 
 Graphics[{Blue, Point[messPoint2D], Red, Point[targetPoint2D]}]]

But something unforeseen happen(just mention here.it have no influence to be a solution),I found the region of bezierCurve different to its graphics

DiscretizeGraphics@bezierCurve

---

As the @Alexey Popkov's comments.We replace BezierCurve with BSplineCurve.Then the process have a beautiful improvement.

bezierCurve = 
  Graphics@BSplineCurve[
    messPoint2D[[Last@FindShortestTour[messPoint2D]]], 
    SplineClosed -> True];
targetPoint2D = 
  RegionNearest[DiscretizeGraphics@bezierCurve, #] & /@ messPoint2D;
Show[bezierCurve, 
 Graphics[{Blue, Point[messPoint2D], Red, Point[targetPoint2D]}]]