3
$\begingroup$

There is a neat way in Mathematica to generate random points on a sphere. Note that "randomness" is defined (somewhat not mathematically strictly) so that the points must be evenly distributed over the sphere (see more info in the linked demo):

enter image description here

Is there a similar (or even very different but reasonable) way of generating random points on Klien's bottle?

klein[u_, v_] := Module[{
   bx = 6 Cos[u] (1 + Sin[u]),
   by = 16 Sin[u],
   rad = 4 (1 - Cos[u]/2),
   X, Y, Z},
  X = If[Pi < u <= 2 Pi, bx + rad Cos[v + Pi], bx + rad Cos[u] Cos[v]];
  Y = If[Pi < u <= 2 Pi, by, by + rad Sin[u] Cos[v]];
  Z = rad Sin[v];
  {X, Y, Z}
  ]

ParametricPlot3D[klein[u, v], {u, 0, 2 Pi}, {v, 0, 2 Pi}, Axes -> False, Boxed -> False]

enter image description here

(code and image courtesy of @e.doroskevic)

Improve this question
$\endgroup$
1
  • $\begingroup$ @whoever cast that vote: You're kidding, surely; a close vote due to "a simple mistake"? maybe a dupe, but I'll give it the benefit of the doubt for now. $\endgroup$
    – LLlAMnYP
    Commented Jun 20, 2017 at 10:14

2 Answers 2

Reset to default
11
$\begingroup$

Here's how you do from first principles. I'd assume this is just what RandomPoint does internally.

compute surface incremental area associated with an area increment in parameter space:

del = 0.01;
da[u_?NumericQ, v_?NumericQ] :=
 Module[{uu, dd},
  uu = Clip[ # + del {-1, 1}, {0, 2 Pi}] & /@ {u, v}; 
  dd = Times @@ Subtract @@@ uu;
  Norm@Cross[
     klein[uu[[1, 2]], v] - klein[uu[[1, 1]], v],
     klein[u, uu[[2, 2]]] - klein[u, uu[[2, 1]]]]/dd ]

(The derivatives could be done analytically here but it takes a bit of hand work due to the If embedded in klein )

In principle if you normalize da you have a 2D PDF , unfortunately RandomVariate cant handle a 2d distribution RandomVariate from 2-dimensional probability distribution so we brute force it here.. ( I'm sure there is a cleaner way to do this, but it gets the job done. )

np = 5000;
rp = klein @@@ (RandomSample[(da @@@ #) -> #, np] &@
     RandomReal[{0, 2 Pi}, {50 np, 2}]);

Show[{
  ParametricPlot3D[klein[u, v], {u, 0, 2 Pi}, {v, 0, 2 Pi}, 
   Axes -> False, Boxed -> False, PlotStyle -> Opacity[.5], 
   Mesh -> None],
  Graphics3D[{Red, Point[rp]}]}]

enter image description here

Improve this answer
$\endgroup$
1
  • $\begingroup$ Here's an exact expression for the surface incremental area: Norm[Cross[{6 Cos[u]^2 - 2 Sin[u] (3 + Cos[v] + 3 Sin[u]) + 2 Cos[v] (Sin[2 u] - Sin[u]) UnitStep[π - u], 16 Cos[u] - 2 (Cos[2 u] - 2 Cos[u]) Cos[v] UnitStep[π - u], 2 Sin[u] Sin[v]}, {2 (Cos[u] - 2) Sin[v] ((1 + Cos[u]) UnitStep[π - u] - 1), 2 (Cos[u] - 2) Sin[u] Sin[v] UnitStep[π - u], 2 (2 - Cos[u]) Cos[v]}]] $\endgroup$
    – J. M.'s missing motivation ♦
    Commented Aug 6, 2017 at 14:21
14
$\begingroup$

There is a function for this since Mathematica 10.2.

graphics = ParametricPlot3D[
   klein[u, v], {u, 0, 2 Pi}, {v, 0, 2 Pi},
   Axes -> False,
   Boxed -> False
   ];

reg = DiscretizeGraphics[graphics];
pts = RandomPoint[reg, 1000];

Show[
 graphics,
 Graphics3D[Point[pts]]
 ]

Mathematica graphics

Improve this answer
$\endgroup$
17
  • 2
    $\begingroup$ Well, your suspicion is unsubstantiated. RandomPoint generates uniform distribution in the embedding space, not in the coordinate space. That's the sole point of having this function. $\endgroup$
    – yohbs
    Commented Jun 19, 2017 at 19:31
  • 12
    $\begingroup$ Well, that's both rude, disrespectful and ungrateful. You asked a question showing zero effort, got an answer saying that what you're looking for is a built in function, expressed unsubstantiated doubts about the implementation of this function, again showing zero effort in supporting your claim nor gratitude for @C.E. For taking the time to answer you, and now you expect us to provide a proof of correctness? Why on earth do you think that someone will do that for you? $\endgroup$
    – yohbs
    Commented Jun 19, 2017 at 19:52
  • 5
    $\begingroup$ You can ask as many questions and raise as many doubts as you want. The basics of etiquette is to show some effort if you want other people to do stuff for you. $\endgroup$
    – yohbs
    Commented Jun 19, 2017 at 20:19
  • 5
    $\begingroup$ Validating the actually uniformity of the RandomPoint distribution should be a new question (The question isn't really specific to the Klein bottle is it?). Of course if you pose the question you should show some thought as to how to approach it. $\endgroup$
    – george2079
    Commented Jun 19, 2017 at 20:47
  • 4
    $\begingroup$ @VividD RandomPoint does sample uniformly over a region. In fact here's a blog post about RandomPoint where in the first paragraph the author talks about how sampling over the parameters of a sphere does not give a uniform sample in this sense. blog.wolfram.com/2015/11/13/… $\endgroup$
    – Greg Hurst
    Commented Jun 20, 2017 at 5:27

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