How to smoothen a surface given as a mesh?

Question

I am trying to "smoothen" meshes. For example, if starting from a cuboid, I would like something similar to a rounded cuboid. There are many ways to smoothen a surface, but I am not going to give a precise definition because I'll be happy with most things that could be qualitatively described as smoothened. It is not a problem if the mesh size changes during the procedure.

How can I smoothen a surface mesh?

---

So what have I done so far and what's wrong with it?

I tried taking every vertex of the mesh and replacing its coordinates with the average of its neighbours. You'll find an implementation below (iter). The problem with this approach is that it makes some shapes more jagged instead of smoother.

E.g. if I discretize a sphere with Mathematica, then smoothen it, then a clearly icosahedral structure emerges. I need the sphere to remain a sphere, or at least not to expose any recognizable regular geometry.

mesh = DiscretizeRegion[RegionBoundary@Ball[]];
smoothenedMesh = Nest[iter, mesh, 150];
{mesh, smoothenedMesh}

The icosahedral structure is not that obvious on a static screenshot, but it becomes very clear once you start rotating it interactively. This is not acceptable because my goal is precisely to try to destroy geometric regularities that can be perceived visually.

---

meshQ[_?MeshRegionQ] := True
meshQ[_?BoundaryMeshRegionQ] := True
meshQ[_] := False

MeshToGraph[mesh_?meshQ] :=
    Graph[Developer`ToPackedArray@MeshCells[mesh, 0][[All, 1]],
      Developer`ToPackedArray@MeshCells[mesh, 1][[All, 1]],
      EdgeWeight -> PropertyValue[{mesh, 1}, MeshCellMeasure],
      VertexCoordinates -> MeshCoordinates[mesh]
    ]

iter[mesh_] := Module[{g, coord, newcoord},
  g = MeshToGraph[mesh];
  coord = MeshCoordinates[mesh];
  newcoord = Mean[coord[[AdjacencyList[g, #]]]] & /@ VertexList[g];
  MeshRegion[newcoord, MeshCells[mesh, 2]]
  ]

---

Here are some test surfaces which may expose other flaws in a smoothening approach.

Graphics3D[
 balls = Table[Ball[RandomReal[1, 3], RandomReal[{0.2, 0.5}]], {20}]
 ]

mesh1 = DiscretizeRegion[
   RegionBoundary[RegionUnion @@ balls],
   MaxCellMeasure -> {2 -> 0.005}
  ]

mesh2 = DiscretizeRegion[
   DiscretizeRegion[RegionBoundary@Cuboid[], 
    MaxCellMeasure -> Infinity], MaxCellMeasure -> {2 -> 0.01}, 
   PlotTheme -> "Default"];

mesh3 = DiscretizeRegion@RegionBoundary@RegionUnion[Cuboid[], Cone[]]

mesh1 should produce an amoeba-like shapeless thing when smoothened. It should not have any sharp or pointy parts.

mesh2 exposes another flaw in my approach: take a look at the corners after smoothening. This however looks more fixable by incremental improvements to the method than the problem I described in the main part of the question.

mesh3 is just another test surface.

Answer 1

In my opinion this question isn't 'well enough' defined, but is this something you're after?

Essentially I plot the iso-surfaces of a certain distance in order to smoothen the mesh, then rescale to the original mesh's bounding box.

smoothMesh[mesh_?MeshRegionQ, fac_:0.25, outer_:True, pp_:Automatic] /; RegionEmbeddingDimension[mesh] == 3 && RegionDimension[mesh] == 2 :=
  Module[{df, ir, isosurfs, surf},
    df = RegionDistance[mesh];
    ir = ImplicitRegion[df[{x, y, z}] == fac, {x, y, z}];
    isosurfs = DiscretizeRegion[ir, # + {-2fac, 2fac}& /@ RegionBounds[mesh], Method -> {Automatic, PlotPoints -> pp}];
    surf = First[If[TrueQ[outer], MaximalBy, MinimalBy][ConnectedMeshComponents[isosurfs], Area]];
    RegionResize[surf, RegionBounds[mesh]]
  ]

smoothMesh[mesh2]

(* the high PlotPoints setting makes this slow... *)
smoothMesh[mesh1, 0.1, False, 100]

Since mesh1 was randomly generated, here's what it looked like before smoothing:

Let me know if this is or isn't what you were wanting.

Answer 2

I've just finished an implementation of the mean curvature flow and I'd like to give some examples of what it can do for you:

 NestList[MeanCurvatureFlow[#, 3, 0.0025, 0.8] &, mesh1, 4]

 NestList[MeanCurvatureFlow[#, 3, 0.0025, 0.8] &, mesh2, 4]

 NestList[MeanCurvatureFlow[#, 3, 0.0025, 0.8] &, mesh3, 4]

Answer 3

I don't have a perfect answer but I will give it a try.

When I apply the function LoopSubdivide from this post to your examples, the results are as follows

NestList[LoopSubdivide, mesh1, 2]

NestList[LoopSubdivide, mesh2, 3]

NestList[LoopSubdivide, mesh3, 3]

As I said, it's not perfect. The issue is that the creases of the initial surfaces are not too clean. The cube would get rounder if the initial mesh was coarser (and a bit more regular).