How to make a random pebble?

Question

I would like to generate a random smooth convex body, like a pebble or a potato (but strictly convex, that's necessary). My attempts:

ConvexHullMesh[RandomReal[1, {10000, 3}], PlotTheme -> "SmoothShading"]

-- clearly bad, too cube-biased;

ConvexHullMesh[ Map[# + RandomReal[.3, 3] &, Flatten[Table[{Cos[u] Cos[v], Cos[u] Sin[v], Sin[u]}, {u, -(\[Pi]/2), \[Pi]/2, \[Pi]/100}, {v, -\[Pi], \[Pi], \[Pi]/200}], 1]], PlotTheme -> "SmoothShading"]

-- better, but now too spherical; besides, both not sufficiently smooth.

What would be a scientific approach? What actually is a random smooth convex body?

Answer 1

As mentioned in the comments this answer produces results too slowly and the pebbles are not that smooth, but since I did go through with the idea (which I find interesting) I am posting the outcomes.

The idea for making a random pebble is to generate random points that would determine pebble's shape and then use a 3D quantile envelope to derive pebble's surface.

Here we generate the random points in such a way that they determine the pebble shape:

data1 =
  RandomVariate[
   MultinormalDistribution[{1, 2, 
     3}, {{3, 0, 0}, {0, 1, 0}, {0, 0, 2}}], 1*10^4];

data2 =
  RandomVariate[
   MultinormalDistribution[{1, 2, 2/5}, 
    0.8 {{1, 0, -1/2}, {0, 1, 0}, {-1/2, 0, 2}}], 1*10^4];

data = Join[data1, data2];
Dimensions[data]

(* {20000, 3} *)

Making random variate mixtures with different distributions and parameters (means/centers, variations/correlation matrices) would bring different pebble shapes.

Some additional rotation (optional):

rmat = RotationMatrix[Pi/3., {{1, 1, 1}, {1, -1, 1}}];
data = data.rmat;

Plot the generated random points:

Block[{qs = 12}, 
  qs = Map[Quantile[#, Range[0, 1, 1/(qs - 1)]] &, Transpose[data]];
  ListPointPlot3D[data, 
  PlotStyle -> {PointSize[0.002]}, PlotRange -> All, 
  PlotTheme -> "Detailed", 
  FaceGrids 
   -> {{{0, 0, -1}, Most[qs]}, {{0, 1, 0}, qs[[{1, 3}]]}, {{-1, 0, 0}, 
     Rest[qs]}}]]

Find the directional quantile envelope:

Import["https://raw.githubusercontent.com/antononcube/MathematicaForPrediction/master/QuantileRegression.m"]
AbsoluteTiming[
 qreg = QuantileEnvelopeRegion[data, 0.95, 78];
]

(* {4.57647, Null} *)

Discretize the obtained region in order to plot it:

AbsoluteTiming[
 bdreg = BoundaryDiscretizeRegion[qreg];
]

(* {168.562, Null} *)

The command above will take less time if smaller number of directions in QuantileEnvelopeRegion are used. (The third argument.) The obtained pebble might have some very flat, angular sides.

Plot together with a sample of the points:

Block[{testData = RandomSample[data, 4000]},
 Show[{ListPointPlot3D[testData, 
    PlotStyle -> {Gray, PointSize[0.006]}], bdreg}]]

Just the pebble by itself:

bdreg

Probably some further refinements or manipulations of the obtained discretized region can be made in order to derive smoother surfaces.

Answer 2

Another approach is to refine a coarse mesh with multiple iterations of Loop subdivision. One such implementation is here.

SeedRandom[123];
init = ConvexHullMesh[RandomReal[{-1, 1}, {8, 3}]];

BoundaryMeshRegion[init, MeshCellStyle -> {1 -> Black}]

Nest[LoopSubdivide, init, 6]

Answer 3

Although there is an accepted answer, let me describe another approach which I stumbled upon on mathoverflow, in form of the question about "derived" polyhedra there.

Start with a random collection of points in 3d; form convex hull; take barycenters of faces; iterate.

Seems like after about ten iterations a reasonably realistic pebble is obtained, even if one starts with an almost regular system of points initially.

subd[mesh_] := With[
 {vertices = MeshCoordinates[mesh], triangles = Map[First, MeshCells[mesh, 2]]}, 
 ConvexHullMesh[Map[Mean[vertices[[#]]] &, triangles]]
]

trim[mesh_, M_] := Nest[subd, mesh, M]

An example: start with

initmesh = ConvexHullMesh[
  {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}, {-.0001, -.000002, -.000000004}, {-.000000000005, 0, -.1}}
]

Then trim[initmesh, 10] produces

I like this version since it sort of imitates the process by which pebbles are actually formed.

Another (either good or bad, depending on what you need from it) feature of this method is that it seems to be extremely sensitive to initial conditions. In my experiments, changing one of the initial coordinates by about one trillionth resulted in quite different final result.

Answer 4

An alternative implementation of the idea in მამუკაჯიბლაძე's answer:

abrade = Nest[ConvexHullMesh[PropertyValue[{#, 2}, MeshCellCentroid]] &, #, #2] &;

Examples:

abrade[ConvexHullMesh[{{1, 0, 0}, {0, 1, 0}, {0, 0, 1}, 
   {-.0001, -.000002, -.000000004}, {-.000000000005, 0, -.1}}], 10]

SeedRandom[1];
abrade[ConvexHullMesh[RandomReal[1, {10, 3}]], 10]