# How to make a blob in 3D?

I am trying to make a blob like the one shown below, but in 3D so I can rotate it. I'm trying to use ParametricPlot3D or SphericalPlot3D. I can make a sphere easily. But my knowledge of how to modify the sphere to make it bulge out in a few places in limited. Anyone have any suggestions? I'd like to make it non symmetric so it look like a random blob like the one below. If I can create the outside blob I'm sure I can create an inside one. I can than place the vectors in the appropriate places. I am a teacher trying to illustrate how to use the divergence theorem on a region like this. Any suggestions would be appreciated. Thank you. • Consider modelling an electrostatic potential isosurface, for instance. – kirma Nov 18 '15 at 5:48
• There was somewhere similar post about marking infinitesimal parts of such surfaces, can't find it :/ – Kuba Nov 18 '15 at 7:25

This can also be made a little lumpier with spherical harmonics.

realization[r_] :=
Assuming[{0 <= θ <= π, 0 <= φ <= 2 π},
Simplify[r + Abs[ComplexExpand[Plus @@ Flatten[
Table[ RandomReal[{-1, 1}] 1/(l^2 + m^2)
SphericalHarmonicY[l, m, θ, φ],
{l, 1, 4}, {m, 0, l}]
]]]]]

Block[{inner, outer},
outer = realization;
inner = realization[1/2];
Show[
SphericalPlot3D[outer, {θ, 0, π}, {φ, 0, 2 π},
PlotStyle -> Directive[Orange, Opacity[0.2], Specularity[White, 10]],
Mesh -> None, PlotPoints -> 50],
SphericalPlot3D[inner, {θ, 0, π}, {φ, 0, 2 π},
PlotStyle -> Directive[GrayLevel[0.4], Opacity[0.2], Specularity[White, 10]],
Mesh -> None, PlotPoints -> 50],
Axes -> False, Boxed -> False
]] • Use the "Image" button on the editing toolbar (the one that looks like a picture of a landscape). I've done it for you this time. – Rahul Nov 18 '15 at 20:41
• @Rahul : I haven't found a way to drag images from Mathematica to the dialog that pops up... – Eric Towers Nov 18 '15 at 23:39
• Oh, I just right-click, "Save Graphic As...", save it as whatever.png, and upload the image file. Not the most luxurious of techniques, I know... – Rahul Nov 19 '15 at 0:17

Here's a function to create a random scalar field:

randomFunction3D[xrange_, yrange_, zrange_] :=
Interpolation[
Flatten[Table[{{x, y, z}, RandomReal[{-1, 1}]},
Evaluate@{x, Sequence @@ xrange},
Evaluate@{y, Sequence @@ yrange},
Evaluate@{z, Sequence @@ zrange}], 2], Method -> "Spline"]


Now instead of drawing a sphere with constant radius $x^2+y^2+z^2=r^2$, let's make the "radius" vary randomly over space, so we get an irregular blobby shape:

SeedRandom;
f = randomFunction3D[{-3, 3}, {-3, 3}, {-3, 3}];
ContourPlot3D[
x^2 + y^2 + z^2 == (1 + 0.4 f[x, y, z])^2, {x, -2, 2}, {y, -2,
2}, {z, -2, 2}, Mesh -> None, PlotRange -> All,
BoxRatios -> Automatic, Boxed -> False, Axes -> False] You can also change the grid spacing to control the size of the bumps:

SeedRandom;
f = randomFunction3D[{-3, 3, 0.25}, {-3, 3, 0.25}, {-3, 3, 0.25}];
ContourPlot3D[
x^2 + y^2 + z^2 == (1 + 0.06 f[x, y, z])^2, {x, -2, 2}, {y, -2,
2}, {z, -2, 2}, Mesh -> None, PlotRange -> All,
BoxRatios -> Automatic, Boxed -> False, Axes -> False] You can have a lot of fun adding a bunch of different random fields with different scalings to create interesting effects, but I'll leave that as an exercise. For inspiration, see Ken Perlin's classic Making Noise talk.

• Congratulations on the Populist badge. – Mr.Wizard Nov 22 '15 at 11:33

I swear I've seen potatoes like this:

realSphericalHarmonic[ℓ_Integer?NonNegative, 0, θ_, φ_] :=
SphericalHarmonicY[ℓ, 0, φ, θ];

realSphericalHarmonic[ℓ_Integer?NonNegative, m_Integer, θ_, φ_] /; -ℓ <= m <= ℓ :=
I^Boole[m < 0] (SphericalHarmonicY[ℓ, -Abs[m], φ, θ] + (-1)^(m + Boole[m < 0])
SphericalHarmonicY[ℓ, Abs[m], φ, θ])/Sqrt

BlockRandom[SeedRandom[42, Method -> "Rule50025CA"]; (* for reproducibility *)

n = 3;
ρ[θ_, φ_] = 1 + Sum[RandomVariate[NormalDistribution[]]
realSphericalHarmonic[k, j, θ, φ]/k!,
{k, 0, n}, {j, -k, k},
Method -> "Procedural"] // FunctionExpand;

ParametricPlot3D[ρ[θ, φ] {Sin[φ] Cos[θ], Sin[φ] Sin[θ], Cos[φ]},
{θ, -π, π}, {φ, 0, π}, Axes -> None, Boxed -> False,
Evaluated -> True, Mesh -> False, PlotPoints -> 55,
ViewPoint -> {-1.3, -2.4, 2.}]] • Simply put...amazing! – Dimitris Nov 19 '15 at 11:10
• Do you think we can use the code from my answer in order to generate a 3D graphic? – Dimitris Nov 19 '15 at 11:12
• I'll need to think about it. – J. M. will be back soon Nov 19 '15 at 11:26
• Couldn't your ParametricPlot3D be replaced with the slightly easier SphericalPlot3D? – Rahul Nov 19 '15 at 18:01
• @Rahul, it can, but the default convention always confuses and vexes me, since it's not the one I'm accustomed to (that is, $\theta$ is the longitude, and $\varphi$ is the colatitude). Note this bias in how I defined the real spherical harmonics as well. – J. M. will be back soon Nov 19 '15 at 18:05

Not exactly what you want but a similar application (demonstration of divergence theorem). I guess it worths. I learnt the code eight years ago when still working with Mathematica 5.2. David Park was responsible for the code.

I tried as possible as I could in order to upgrade it so that it works with recent versions.

partitionfunction[d_][q_] :=
Piecewise[{{Sin[(Pi*q)/(2*d)]^2,
Inequality[0, LessEqual, q, Less, d]}, {1,
Inequality[d, LessEqual, q, Less,
2*Pi - d]}, {Sin[(Pi*(2*Pi - q))/(2*d)]^2,
2*Pi - d <= q <= 2*Pi}}]

1 + 1.5*partitionfunction[d][q]*BesselJ[5, (13/(2*Pi))*q + 5]

tangent[t_] =
N[curve[45*Degree] + t*Derivative[curve][45*Degree]];

normal[t_] =
N[curve[45*Degree] +
t*Reverse[Derivative[curve][45*Degree]]*{1, -1}];

n = {1.127382730502271, 1.037382730502271};

g = ParametricPlot[curve[q], {q, 0, 2*Pi}, Axes -> False,
PlotPoints -> 50, PlotStyle -> Thickness[0.007],
Exclusions -> None];
line = Cases[g, l_Line :> First@l, Infinity];
g1 = Graphics[{Opacity[0.4], Darker@Orange,
EdgeForm[{Thick, Darker@Orange}], Polygon[line]}, Options[g]];
Arrow[{normal, normal[0.3]}]}];
g3 = ParametricPlot[tangent[t], {t, -0.2, 0.2},
PlotStyle -> Thickness[0.006], PlotPoints -> 50];
cir = Graphics[{Circle[normal, 0.1, {3.3*(Pi/2), 2.15*Pi}]}];
po = Graphics[{PointSize[0.01], Point[n]}];
tex1 = Graphics[Text[Style["V", 17], {0.0532359, -0.0138103}]];
tex2 = Graphics[Text[Style["S", 17], {0.470751, -1.08655}]];
tex3 = Graphics[Text[Style["n", 17, Italic, Black, Bold], {1.5, 1.2}]];
Show[{g1, g2, g3, cir, po, tex1, tex2, tex3}, PlotRange -> All] Just for fun: Here is the old good code for 5.2 (!), for anyone interested.

Block[{\$DisplayFunction = Identity},
g =
ParametricPlot[curve[o1], {o1, 0, 2*Pi},
Axes -> False, PlotPoints -> 50,
PlotStyle -> Thickness[0.007]];
g1 = g /. Line[x_] -> {GrayLevel[0.8], Polygon[x]};
g2 =
ParametricPlot[tangent[t], {t, -0.2, 0.2},
PlotStyle -> Thickness[0.006], PlotPoints -> 50];
g3 =
Graphics[
{Thickness[0.007], Arrow[normal, normal[0.3],
cir =
Graphics[{Circle[normal, 0.1, {3.3*(Pi/2), 2.15*Pi}]}];
po = Graphics[{PointSize[0.01], Point[n]}];
tex1 = Graphics[Text["V", {0.0532359, -0.0138103}]];
tex2 = Graphics[Text["S", {0.470751, -1.08655}]];
tex3 =
Graphics[
Text[StyleForm["n", FontSize -> 17, FontFamily -> "Times",
FontColor -> Black, FontWeight -> "Bold"],
{1.7, 1.2}]];
]

Show[
g, g1, g2, g3, tex1, tex2, tex3, cir, po,
AspectRatio -> Automatic,
TextStyle ->
{FontSize -> 17, FontFamily -> "Times", FontWeight -> "Bold"}
];

• I guess a challenge is to use this approach in order to make 3D graphic. But this is beyond me:-)! – Dimitris Nov 18 '15 at 16:41