14
$\begingroup$

How to plot a random points around the following Helix curve?

 ParametricPlot3D[{6 Cos[t], 6 Sin[t], t}, {t, -2 π, 4 π}, 
 PlotTheme -> "Detailed", PlotStyle -> {Blue, Thickness[Large]}, 
 Boxed -> False, PlotPoints -> 150]

helix

Maximal distance from the given curve to random points is $0.5$

$\endgroup$
17
$\begingroup$

Using RandomPoint[] with TubeMesh[] (routines from here and here) does the job:

helix = First[Cases[Normal[ParametricPlot3D[{6 Cos[t], 6 Sin[t], t}, {t, -2 π, 4 π},
                                           MaxRecursion -> 1, PlotPoints -> 75]],
                   Line[l_] :> l, ∞]];

tube = TubeMesh[helix, 1/2, "CapForm" -> "Round"];
BlockRandom[SeedRandom[42]; 
Graphics3D[{AbsolutePointSize[1], Point[RandomPoint[tube, 5000]]}]]

random points around helix

$\endgroup$
  • $\begingroup$ I find it terribly amusing that this has more votes than the answer I linked to, which has the actual routines. :P $\endgroup$ – J. M. is away Jan 23 '17 at 10:44
7
$\begingroup$

There are many ways to define a random collection of points that all fall within a distance 0.5 of the curve. If a uniform distribution within a "tube" of radius 0.5 surrounding the curve is what you want and have a newer version of Mathematica, then @J.M.'s answer is the way to go.

If you have an older version of Mathematica, here is a brute-force approach:

(* Random error about curve no farther than 0.5 *)
n = 1000;
(* Random points within a uniform box around curve *)
r0 = RandomVariate[UniformDistribution[{-0.5, 0.5}], 3 n];
rC = RandomVariate[UniformDistribution[{-0.5, 0.5}], 3 n];
rS = RandomVariate[UniformDistribution[{-0.5, 0.5}], 3 n];
(* Keep the first n points that are within 0.5 of the curve *)
error = Select[Transpose[{rC, rS, r0}], Norm[#] <= 0.5 &, n];

(* Random position along curve *)
rt = RandomVariate[UniformDistribution[{-2 π, 4 π}], n];

(* Show resulting cloud of points and curve *)
Show[ParametricPlot3D[{6 Cos[t], 6 Sin[t], t}, {t, -2 π, 4 π},
  PlotTheme -> "Detailed", PlotStyle -> {Blue, Thickness[Large]},
  Boxed -> False, PlotPoints -> 150],
 ListPointPlot3D[Transpose[{6 Cos[rt], 6 Sin[rt], rt}] + error, 
  BoxRatios -> {1, 1, 1}]]

3D points and curve

$\endgroup$
  • 2
    $\begingroup$ Rejection sampling is nice if you don't have anything else. On that note: error = Select[RandomReal[{-0.5, 0.5}, {3 n, 3}], Norm[#] <= 0.5 &, n]; looks to be a shorter way to go about your initial sampling. $\endgroup$ – J. M. is away Dec 16 '16 at 17:26
  • $\begingroup$ @J.M. Agreed. Other than good examples like yours, I wonder how someone who uses Mathematica for statistical analysis would stumble across the "mesh" functions which can make random sampling in regions much simpler than a brute-force algebraic approach. I guess that's my main issue with Mathematica. There's so much in areas that I would unlikely venture into but could simplify my life greatly. $\endgroup$ – JimB Dec 16 '16 at 17:38
  • 1
    $\begingroup$ For reference, here's another equivalent sampling approach: With[{t = RandomReal[{-2 π, 4 π}], v = RandomVariate[NormalDistribution[], 3], y = RandomVariate[ExponentialDistribution[1]]}, {6 Cos[t], 6 Sin[t], t} + r v/Sqrt[y^2 + v.v]] (r being the radius of the tubular neighborhood). $\endgroup$ – J. M. is away Dec 16 '16 at 18:15
7
$\begingroup$

This answer is based on a different line of reasoning than my previous answer.


plot = ParametricPlot3D[{6 Cos[t], 6 Sin[t], t}, {t, -2 Pi, 
    4 Pi}, PlotTheme -> "Detailed", 
   PlotStyle -> {Red, Thickness[Large]}, Boxed -> False, 
   PlotPoints -> 150];

After inspecting FullForm @ plot, one can extract a Line with Cases[FullForm @ plot, _Line, Infinity] and transform it to a Cylinder (Tube would be more straightforward, but it's not a Region):

Show[plot /. Line[z_] :> Cylinder[Partition[z, 2, 1], 0.5], PlotRange -> All]

enter image description here

Looks good, so

reg = Cases[FullForm @ plot, _Line, Infinity] /. 
   Line[z_] :> Cylinder[Partition[z, 2, 1], 0.5] // First

and then

points = RandomPoint[reg, 1000];

to give

Show[plot, ListPointPlot3D @ points]

enter image description here


line = Cases[FullForm @ plot, _Line, Infinity][[1]];
dist = RegionDistance[line, #] & /@ points; // AbsoluteTiming

{63.0501, Null}

Histogram @ dist

enter image description here

The distance from the curve has a peculiar distribution, though.



Previous answer

Employing RandomPoint @ Ball:

Clear[plot, data, line, dist]

f[t_] := {6 Cos[t], 6 Sin[t], t}

c = ParametricPlot3D[f[t], {t, -2 Pi, 4 Pi}, 
  PlotTheme -> "Detailed", PlotStyle -> {Red, Thickness[Large]}, 
  Boxed -> False, PlotPoints -> 150];

plot = ListPointPlot3D @ (data = 
  Table[RandomPoint @ Ball[f[t], 0.5], {t, -2 Pi, 4 Pi, 0.01}]);

Show[c, plot]

enter image description here


Checking the distance distribution:

line = Cases[FullForm @ c, _Line, Infinity][[1]];
dist = RegionDistance[line, #] & /@ data; // AbsoluteTiming

{120.033, Null}

Length @ dist

1885

Histogram @ dist

enter image description here

$\endgroup$
  • 1
    $\begingroup$ That is the correct distribution. Consider a cross-section, which is a disk: there are a lot of points at distance $0.5$ but only one point at distance $0$ :) More formally, the probability density at $d$ is proportional to the measure of the set of points at distance $d$, which is the surface area of the tube of radius $d$ and increases linearly with $d$. $\endgroup$ – Rahul Dec 16 '16 at 23:03
  • $\begingroup$ I'll put it here, I guess: it seems to me that the Table[(* stuff *), {t, -2 π, 4 π, 0.01}] is one source of non-uniformity in your generator, and With[{t = RandomReal[{-2 π, 4 π}]}, RandomPoint[Ball[{6 Cos[t], 6 Sin[t], t}, 0.5]]] removes that non-uniformity. As for the cylinder-based approach, that misses sampling the spherical caps at both ends of the curve (think of the difference between Tube[] with CapForm["Round"] and CapForm["Butt"]). $\endgroup$ – J. M. is away Dec 17 '16 at 3:39
4
$\begingroup$
f[t_] := {6 Cos[t], 6 Sin[t], t}

c = ParametricPlot3D[f[t], {t, -2 Pi, 4 Pi}, 
  PlotTheme -> "Detailed", PlotStyle -> {Red, Thickness[Large]}, 
  Boxed -> False, PlotPoints -> 150];

The idea is to:

  1. pick randomly a parameter t0 on the curve;
  2. make a vector f'[t0] tangent to the curve at t0;
  3. choose a random vector n;
  4. create with a cross product a vector cross of length 0.5, and perpendicular to f'[t0] and n;
  5. choose a random point on a line joining the points f[t0] and f[t0] + cross.

The above is gathered as

rand := Block[{t0, n, cross},
  t0 = RandomReal[{-2 Pi, 4 Pi}];
  n = RandomReal[{-1, 1}, 3];
  cross = Normalize @ Cross[n, f'[t0]]/2;
  RandomPoint @ Line[{f[t0], f[t0] + cross}]
  ]

Generate 1000 such points:

plot = ListPointPlot3D @ (data = Table[rand, {1000}]);

Show[c, plot]

enter image description here

Distribution of the distances of the points to the curve (see also my second answer):

line = Cases[FullForm @ c, _Line, Infinity][[1]];
dist = RegionDistance[line, #] & /@ data; // AbsoluteTiming

{62.6192, Null}

Histogram @ dist

enter image description here

is uniform.

$\endgroup$
  • $\begingroup$ As I mentioned in my other comment, this is the incorrect distribution for this problem. See the figures at the beginning of mathworld.wolfram.com/DiskPointPicking.html; you are creating the left distribution rather than the right. $\endgroup$ – Rahul Dec 17 '16 at 15:24
  • $\begingroup$ @Rahul The OP only wrote that he wants "random points around the curve". He didn't specify according to which distribution. I gave three different methods that give three sets of points sampled from different distributions. How can you say which one is "correct"? In other words: is a Gaussian distribution "more correct" than a triangular distribution? Your plea (and downvote, if it was yours) is unjustified in the context of the question. $\endgroup$ – corey979 Dec 17 '16 at 21:49
  • 1
    $\begingroup$ Technically you are correct, and technically this is a random number generator. However I would downvote it too if it was posted as a way to generate a random number between 1 and 10. $\endgroup$ – Rahul Dec 17 '16 at 22:06
  • 2
    $\begingroup$ @Rahul So this is a random distribution for you, but this is not? And <"technically you are correct", but I'll downvote anyway> - congrats on that reasoning. $\endgroup$ – corey979 Dec 18 '16 at 9:24
1
$\begingroup$

This can be done as follows.

a = ParametricPlot3D[{6 Cos[t], 6 Sin[t], t}, {t, -2 \[Pi], 4 \[Pi]},
PlotTheme -> "Detailed", PlotStyle -> {Blue, Thickness[Large]},
Boxed -> False, PlotPoints -> 150];
b = Table[{6 Cos[t], 6 Sin[t], t}, {t, -2 \[Pi], 4 \[Pi], .1}];
c = Table[RandomVariate[UniformDistribution[{-0.5, 0.5}], 3], {t, -2 \[Pi], 
4 \[Pi], .1}];
Show[a, ListPointPlot3D[b + c]]

enter image description here

Addition.

c = Table[RandomVariate[UniformDistribution[{-0.5^(1/2)/3, 0.5^(1/2)/3}], 
3], {t, -2 \[Pi], 4 \[Pi], .1}];
N[0.5^(1/2)/3]

0.235702

is exacter.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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