279
$\begingroup$

I'm trying to develop a function which 3D plot would have a buttocks like shape.

Several days of searching the web and a dozen my of own attempts to solve the issue have brought nothing but two pitiful formulas below.

They have some resemblance to the shape I want, though not quite.

Could you help me to obtain a proper formula?

Here are those bad solutions I've got myself:

ParametricPlot3D[{Sin[y] Sqrt[1 - (Abs[x] - 1)^2], 
  Cos[y] Sqrt[1 - (Abs[x] - 1)^2], x}, {x, -10, 10}, {y, -3 Pi, 3 Pi},
  AspectRatio -> Automatic] 

Mathematica graphics

and the following:

Plot3D[((2 Sqrt[30 - x^2 - 2^-x]/3) + Sqrt[1 - (Abs[y] - 1)^2])/2,
   {x, -7, 7}, {y, -7, 7}, AspectRatio -> Automatic]

Mathematica graphics

$\endgroup$
  • 96
    $\begingroup$ Probably there are only half-assed solutions available yet. $\endgroup$ – Yves Klett Nov 25 '14 at 10:34
  • 8
    $\begingroup$ @YvesKlett be careful, it happened once :P Evidently, we are... $\endgroup$ – Kuba Nov 25 '14 at 10:54
  • 6
    $\begingroup$ I come back after not checking the site overnight, and this is what I wake up to. $\endgroup$ – DumpsterDoofus Nov 25 '14 at 14:47
  • 7
    $\begingroup$ If only ExampleData[{"Geometry3D", "Beethoven"}] was a full-body model, a judicious use of PlotRange would do it. $\endgroup$ – Rahul Nov 25 '14 at 16:16
  • 43
    $\begingroup$ The quality of the responses does seem to be a validation of the merits of this question, albeit a posteriori. $\endgroup$ – Daniel Lichtblau Nov 25 '14 at 16:34
428
+50
$\begingroup$

I have to confess that I see this as a proper challenge, as I am usually quite creative in finding/combining functions to provide a desired behavior. So I will give it another try.

Mathematica graphics

which is generated using

box[x_, x1_, x2_, a_, b_] := Tanh[a (x - x1)] + Tanh[-b (x - x2)];
ex[z_, z0_, s_] := Exp[-(z - z0)^2/s]

(*and*)

r[z_, x_] := (*body*).4 (1.0 - .4 ex[z, .8, .15] + 
Sin[2 π x]^2 + .6 ex[z, .8, .25] Cos[2 π x]^2 + .3 Cos[2 π x]) 0.5 (1 + Tanh[4 z]) +
(*legs*)
(1 - .2 ex[z, -1.3, .9]) 0.5 (1 + Tanh[-4 z]) (.5 (1 + Sin[2 π x]^2 +
 .3 Cos[2 π x])*((Abs[Sin[2 π x]])^1.3 + .08 (1 + Tanh[4 z])  )  ) +
(*improve butt*)
.13 box[Cos[π x], -.45, .45, 5, 5] box[z, -.5, .2, 4, 2] - 
0.1 box[Cos[π x], -.008, .008, 30, 30] box[z, -.4, .25, 8, 6] - 
.05 Sin[π x]^16 box[z, -.55, -.35, 8, 18]

(*and finally*) 

ParametricPlot3D[
(*shift butt belly*)
{.1 Exp[-(z-.8)^2/.6] - .18 Exp[-(z -.1)^2/.4], 0, 0} + {r[z, x] Cos[2 π x], r[z, x] Sin[2 π x],z}, 
{x, 0, 1}, {z, -1.5, 1.5},
PlotPoints -> {150, 50}, Mesh -> None,
AxesLabel -> {"x", "y", "z"}]

Edit What was the strategy in generating the graph (answering the comment of @mcb)

Inspired by some of the solutions here and the fact that the original question seems to head direction Plot3D[] or ParametricPlot3D[], the idea is to use a cylinder as base. I remembered from other work that a parametric curve of type 1+Cos[t] gives something butt-shaped and 1+ a Cos[t] can give something like a torso cross section. To make it a little bit more elliptical I added a 1+Sin[t]^2type. Combining this already goes in the right direction.

Legs are also not very complicated. Just fold the cylinder into two by,e.g, Abs[Sin[t]]. To make the transition from legs to torso I use a soft step based on Tanh[].

Next step is to push it in and out in the correct way (belly and butt), so there is a shift to the cylinder based on Gaussians.

At the end one adds features like waist, etc. using Gaussians or adjustable smooth box-like functions.

Done, overall not too complicated.

$\endgroup$
  • 68
    $\begingroup$ ...although I have to say that it is a little bit embarrassing that my "reputation" up to now is mainly from this thread. $\endgroup$ – mikuszefski Nov 25 '14 at 18:19
  • 44
    $\begingroup$ This is the first answer on this site that has literally made me go "what the f—" out loud. So congratulations for that. $\endgroup$ – Rahul Nov 25 '14 at 18:24
  • 37
    $\begingroup$ Em-bare-assing? No way. Epic, more like! And who says math ain't sexy now? $\endgroup$ – Yves Klett Nov 25 '14 at 19:17
  • 53
    $\begingroup$ -1 I rotated it to no avail $\endgroup$ – Dr. belisarius Nov 26 '14 at 5:12
  • 44
    $\begingroup$ Joined Mathematica just to +1 this. Well done. $\endgroup$ – aportr Nov 26 '14 at 23:15
214
$\begingroup$

This might get me suspended from the site butt I cannot resist.

The shape you are looking for can probably be approximated (depending how anal you want to be about the outcome) by two assymetric probability distributions. The obvious choices would be a Poasson or a log normal distribution. I will use the latter as it is continuous. Now the bummer is that you have to smoothen them out somehow so I will use an exponential to do that. Since it is the overlap of the two functions that I am interested, I need to add some filling so that the individual sheets don't show (cheeky, I know). I chose Filling->Bottom for that. The final result is shown below (please don't be harse in judging it):

Plot3D[{
  -PDF[LogNormalDistribution[1, 1], (y + .3)^2 + x^2] E^(.8 (y + .7)^2), 
  -PDF[LogNormalDistribution[1, 1], (y - .3)^2 + x^2] E^(.8 (y - .7)^2)
 }, 
 {x, -1.,1.4}, {y, -.9, .9},
 Filling -> Bottom,
 FillingStyle -> Opacity[1],
 PlotStyle -> {Brown, Brown},
 Lighting -> "Neutral",
 Boxed -> False,
 Axes -> False,
 Mesh -> None,
 PlotRange -> {Automatic, Automatic, {-.4, .3}}]

Rendered image of the parametric butt

Cracking!

$\endgroup$
  • 8
    $\begingroup$ youtu.be/FtmjgeEL-tk $\endgroup$ – Yves Klett Nov 25 '14 at 12:00
  • 10
    $\begingroup$ And good use of misspelling (I think life was better before the advent of the spell checker anyway). $\endgroup$ – Daniel Lichtblau Nov 25 '14 at 16:26
  • 13
    $\begingroup$ @DanielLichtblau I think you mean spell cheecker. $\endgroup$ – Cammy_the_block Nov 25 '14 at 22:17
  • 10
    $\begingroup$ @Cammy_the_block Yes, my mistake. Spanks for catching it. $\endgroup$ – Daniel Lichtblau Nov 25 '14 at 23:49
  • 8
    $\begingroup$ "Filling -> Bottom"? Really? $\endgroup$ – dwa Nov 27 '14 at 8:06
115
$\begingroup$

Parametric Buttocks Manipulator

Manipulate[
 ParametricPlot3D[{
   (e u^p + (1 + (c - a u) (u - 1)) Cos[t]^2) Sin[t],
   (e u^p + (1 + (d - b u) (u - 1)) Cos[t]^2) Cos[t],
   2 u}, {t, -0.2, Pi + 0.2}, {u, 0, 1.1}, Lighting -> "Neutral", Mesh -> None, 
  PlotStyle -> Directive[Specularity[0], RGBColor[0.92, 0.85, 0.73]], Axes -> False],
 {{a, 7}, 2, 10},
 {{b, 2.5}, 1, 3},
 {{c, -0.5}, -1, 0},
 {{d, -0.5}, -1, 0},
 {{e, 0.7}, 0.5, 1},
 {{p, 2.5}, 1, 5}]

enter image description here

$\endgroup$
  • 10
    $\begingroup$ It's all about the bass, 'bout the bass, no treble... $\endgroup$ – rm -rf Nov 25 '14 at 13:58
  • 17
    $\begingroup$ @Öskå, I agree, your butt is nicer than mine. $\endgroup$ – Simon Woods Nov 25 '14 at 14:17
  • 7
    $\begingroup$ This only looks like a bra. $\endgroup$ – Ludwik Nov 25 '14 at 20:01
  • 11
    $\begingroup$ @Ludwik, dammit I knew I should have paid attention in anatomy class! $\endgroup$ – Simon Woods Nov 25 '14 at 20:33
  • 9
    $\begingroup$ However, the last few lines of code are actually quite buttock-shaped. Was that intentional? $\endgroup$ – itsbruce Nov 26 '14 at 18:43
49
$\begingroup$

Scientific progress! In v10.3 with all the goodies in AnatomyData we can now use the simple code:

Entity["AnatomicalStructure", "Skin"]["Graphics3D"]

Mathematica graphics

Zoom in on the appropriate part and you're done.

pelvisLoc = AnatomyData[Entity["AnatomicalStructure", "Pelvis"], "RegionBounds"]; 
Show[
   Entity["AnatomicalStructure", "Skin"]["Graphics3D"], 
   PlotRange -> pelvisLoc, 
   PlotRangePadding -> {33, 33, 19},
   ViewPoint -> {0.961, 1.62, 0.203}, 
   ViewVertical -> {0.109, 0.284, 1.202}
]

Mathematica graphics

Although not parametric, I thought it would be a nice addition to the other answers.

For those at work: I would advise to leave the Viewpoint where it is.

$\endgroup$
  • 10
    $\begingroup$ It's a new kind of buttocks, you know. $\endgroup$ – kirma Oct 18 '15 at 14:22
  • 12
    $\begingroup$ @kirma At least they didn't use you-know-who to stand model here. $\endgroup$ – Sjoerd C. de Vries Oct 18 '15 at 14:44
  • 4
    $\begingroup$ pelvisLoc is the best function name ever! $\endgroup$ – gpap Oct 19 '15 at 19:31
35
$\begingroup$

Well, an unusual question to answer, what about something like this

Plot3D[.7*(1 + Tanh[1 - (2*Y^2 + X^2 + X^4)]) - .3*Exp[-X^2/.0025]*
   Exp[-(Y - .1)^2/.15] - .2*(Exp[-(X - .7)^2/.02]*Exp[-(Y - .0)^2/.08] + 
     Exp[-(X + .7)^2/.02]*Exp[-(Y - .0)^2/.08]), {X, -1, 1}, {Y, -1, 1}]

Mathematica graphics

$\endgroup$
  • 12
    $\begingroup$ Right! You finally put Tanh to some astounding use (I was always wondering what it was good for)! $\endgroup$ – Yves Klett Nov 25 '14 at 15:20
  • 1
    $\begingroup$ One of my favorites! $\endgroup$ – mikuszefski Nov 25 '14 at 18:12
  • 13
    $\begingroup$ If I had to guess which body part this represents, my first answer would not be a butt. $\endgroup$ – Nikolaj-K Nov 27 '14 at 13:42
17
$\begingroup$

Just a combination of Graphics3D objects

Graphics3D[{Scale[
Cylinder[{{0, 0.9, -0.5}, {2, 0.7, 0.5}}, 0.75], {1, 0.95, 1}],  
Scale[Cylinder[{{0, -0.9, 0}, {2, -0.7, 0}}, 0.75], {1.0, 0.95, 1}],
Scale[Cylinder[{{-1.1, 0, 0}, {-0.3, 0, 0}}, 1.5], {1, 1, 0.5}],
Scale[Sphere[{0., 0.75, -0.25}, 1.05], {1.1, 0.9, 1}],
Scale[Sphere[{0., -0.75, 0.1}, 1.05], {1.1, 0.9, 1}],
Sphere[{-0.2, 0, 0.2}, 0.65],
Scale[Sphere[{-0.4, 0, -0.2}, 1.2], {0.6, 1.3, 0.75}],
}, PlotRange -> All, Boxed -> False, 
Lighting -> ({"Spot", ColorData["SouthwestColors"][RandomReal[]], 
   Scaled[#], {Pi/4, 100}} &) /@ RandomReal[{-4, 4}, {5, 3}]]

enter image description here

$\endgroup$
  • $\begingroup$ Interesting ansatz...good one. $\endgroup$ – mikuszefski Nov 27 '14 at 16:02
  • 47
    $\begingroup$ Those hemorrhoids though... $\endgroup$ – Frigo Nov 30 '14 at 18:34
  • $\begingroup$ Well, I guess it is inspired by Fernando Botero sculptures. $\endgroup$ – mikuszefski Nov 30 '14 at 20:48

protected by rm -rf Nov 27 '14 at 8:25

Thank you for your interest in this question. Because it has attracted low-quality or spam answers that had to be removed, posting an answer now requires 10 reputation on this site (the association bonus does not count).

Would you like to answer one of these unanswered questions instead?

Not the answer you're looking for? Browse other questions tagged or ask your own question.