How do I draw a pair of buttocks?

  • 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

    Probably there are only half-assed solutions available yet.

    @YvesKlett Damn, I gotta start collecting those comments ...

    @Sektor and do not get me started on the edit potential for the title. Just one additional letter would make all the hot post difference ;-)

    @YvesKlett be careful, it happened once :P Evidently, we are...

    May I ask the purpose of this? Is it safe?

    I come back after not checking the site overnight, and this is what I wake up to.

    Youse all crack me up..

    If only `ExampleData[{"Geometry3D", "Beethoven"}]` was a full-body model, a judicious use of `PlotRange` would do it.

    The quality of the responses does seem to be a validation of the merits of this question, albeit a posteriori.

    It's becoming a "hot" topic, evidently!

    When I saw this in the network questions list I thought it was an Arqade link

    Seriously? A bounty? Hasn't this ridiculous question had enough attention already?

    @Rikki would it be a 'tweet' or perhaps more accurately a 'toot' ?

  • 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.

    ...although I have to say that it is a little bit embarrassing that my "reputation" up to now is mainly from this thread.

    This is the first answer on this site that has literally made me go "what the f—" out loud. So congratulations for that.

    Em-bare-assing? No way. Epic, more like! And who says math ain't sexy now?

    -1 I rotated it to no avail

    Joined Mathematica just to +1 this. Well done.

    @belisarius Since rotation does not work, have you tried a Legender transform?

  • 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!

    It was your comment that started it all :)

    And good use of misspelling (I think life was better before the advent of the spell checker anyway).

    The filling really gives it this little extra!

    @DanielLichtblau I think you mean spell cheecker.

    @Cammy_the_block Yes, my mistake. Spanks for catching it.

    `Filling -> Bottom` is fine, but I would use `Lighting -> "Subtle"` instead of `"Neutral"`... `Mesh` would be helpful too, I don't know why you omitted it...

    @gpap; who would have thought...

    "Filling -> Bottom"? Really?

    @dwa no pun intended...

    An unusual application of the Lognormal distributtion

    It's "Poisson" not "Poasson" (although the pronunciation is more like the latter) - and I can't fix that damned typo, because *"edits must be at least 6 characters long".*

    Oh, ok. No pun intended right?

    @peterps *So* difficult? :) In addition to your typo correction, use just one synonym elsewhere in your post (e. g. change 'propose' into 'suggest') and voila, you've met the editing requirements.

    @DanDascalescu why did you edit out the Poasson pun? If feel the original version was so, well, *original* that just about no editing will be beneficial.

    @Yves: it was a pun? As peterph mentioned it was a typo. Plus, I added another pun.

    @DanDascalescu I´d guess it was intentional by gpap - at least there is no statement here to the opposite. And adding another bottom just does not appeal to me in the sense that the post was so ingeniously authored to begin with that embellishing would do no good.

    @YvesKlett: feel free to undo my edit. I won't object.

    @DanDascalescu I´d rather leave it to the author - he should have some authority here ;-)

    @DanDascalescu (@YvesKlett: thanks for the kind words!) I noticed the edit, I just didn't want to re-edit as it would bounce the post and I think the moderators got into a bit of a pickle with all the spam associated with this. But, yep, Poasson was deliberate :) changed it back...

    Ass I said: Sassy, that post wass ;-)

    @gpap: I'm not a native speaker. Can you explain the Poasson pun?

    @DanDascalescu Ehm, po**ass**on?

  • 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

    It's all about the bass, 'bout the bass, no treble...

    I can't believe I actually spent time to "improve" my answer after seeing yours. This has great silliness potential..

    IMO the butt looks nicer with these parameters: http://i.imgur.com/DmFYQTY.png

    @Öskå, I agree, your butt is nicer than mine.

    @gpap ´s not silly. ´s really badass!

    This only looks like a bra.

    @Ludwik, dammit I knew I should have paid attention in anatomy class!

    However, the last few lines of code are actually quite buttock-shaped. Was that intentional?

    the answer above and this answer can be used to make a great creation. I maths is awesome.

  • 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.

    It's a new kind of buttocks, you know.

    @kirma At least they didn't use you-know-who to stand model here.

    pelvisLoc is the best function name ever!

  • 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

    Right! You finally put `Tanh` to some astounding use (I was always wondering what it was good for)!

    One of my favorites!

    If I had to guess which body part this represents, my first answer would not be a butt.

  • 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

    Interesting ansatz...good one.

    Those hemorrhoids though...

    Well, I guess it is inspired by *Fernando Botero* sculptures.

License under CC-BY-SA with attribution


Content dated before 6/26/2020 9:53 AM