1
$\begingroup$

Here's a code that draws a pack of random straight lines in 3D:

Corde[s_, x0_, y0_, z0_, u_, phi_] := {
  x0 + s Sqrt[1 - u^2] Cos[phi],
  y0 + s Sqrt[1 - u^2] Sin[phi],
  z0 + s u
  }

x0[n_] := RandomReal[{-10, 10}];
y0[n_] := RandomReal[{-10, 10}];
z0[n_] := RandomReal[{-10, 10}];
u0[n_] := RandomReal[{-1, 1}];
phi0[n_] := RandomReal[{0, 2 Pi}];

Cordes[s_] := Table[
  Corde[s, x0[n], y0[n], z0[n], u0[n], phi0[n]], {n, 1, 10}]

Enchevetrement = 
  ParametricPlot3D[Evaluate@Cordes[s], {s, -20, 20}, PlotPoints -> 2];

Show[Enchevetrement,
 PlotRange -> {{-10, 10}, {-10, 10}, {-10, 10}},
 Axes -> True,
 Ticks -> None,
 AxesStyle -> Opacity[0.25],
 AxesOrigin -> {0, 0, 0},
 SphericalRegion -> True,
 Method -> {"RotationControl" -> "Globe"},
 ImageSize -> {700, 700}
 ]

Preview:

enter image description here

I would like to make them looking like some kind of natural random walks by adding noise to the lines. The result should be smooth looking (no discontinuities, the curves should stay smooth). The randomness resolution should be an option to increase the paths complexity.

In other words: each straight line should get some random wavy noise.

Take note that I'm using Mathematica 7.0, and I can't upgrade the machine to a newer version of Mathematica. So the code modifications should stay close to the original code, with just a few new simple functions. Nothing fancy.

EDIT: Using kglr's code below, I get what appears to be closed curves, with a pesky straight line as shown below:

enter image description here

I need to get rid of these long straight lines...

Improve this question
$\endgroup$
4
  • $\begingroup$ try replacing BSplineCurve[RandomReal[{-a, a}, 3] + # & /@ x] with BSplineCurve[RandomReal[{-a, a}, 3] + # & /@ x, SplineClosed -> False]? $\endgroup$
    – kglr
    Commented Nov 30, 2020 at 17:41
  • $\begingroup$ @kglr, I tried this option and it does nothing! The straight line is still there. $\endgroup$
    – Cham
    Commented Nov 30, 2020 at 17:49
  • $\begingroup$ can you try BSplineCurve[Rest@Most[RandomReal[{-a, a}, 3] + # & /@ x]]? $\endgroup$
    – kglr
    Commented Nov 30, 2020 at 17:57
  • $\begingroup$ can you post the output from SeedRandom[1]; ParametricPlot3D[Evaluate@Corde[s, x0[n], y0[n], z0[n], u0[n], phi0[n]], {s, -20, 20}, PlotPoints -> 20][[1]]? $\endgroup$
    – kglr
    Commented Nov 30, 2020 at 21:19

1 Answer 1

Reset to default
2
$\begingroup$

Perhaps

a = 1; pp = 50;

SeedRandom[1]
Enchevetrement =  ParametricPlot3D[Evaluate@Cordes[s], {s, -20, 20}, 
   PlotPoints -> pp, MaxRecursion -> 1];


Show[Enchevetrement /. Line[x_] :> BSplineCurve[RandomReal[{-a, a}, 3] + # & /@ x], 
 PlotRange -> {{-10, 10}, {-10, 10}, {-10, 10}}, Axes -> True, 
 Ticks -> None, AxesStyle -> Opacity[0.25], AxesOrigin -> {0, 0, 0}, 
 SphericalRegion -> True, Method -> {"RotationControl" -> "Globe"}, 
 ImageSize -> {700, 700}]

enter image description here

Play with a and pp to control the amplitude and frequency to get various shapes: For example, with pp = 200 and a = .3 we get

enter image description here

Use a = 1; pp = 200; and replace BSplineCurve[RandomReal[{-a, a}, 3] + # & /@ x] with BSplineCurve[({Abs@#, ##2} & @@ RandomReal[{-a, a}, 3]) + # & /@ x] to prevent bending backward in x direction:

enter image description here

Improve this answer
$\endgroup$
5
  • $\begingroup$ That's very nice! Please, could you elaborate on the #&/@x ? I don't understand this part. Also, on my system, I get a long straight line added to the random noisy lines, like a closing line. I'm unable to get rid of it yet. $\endgroup$
    – Cham
    Commented Nov 30, 2020 at 17:17
  • 1
    $\begingroup$ @Cham, the pure function ` foo = RandomReal[{-a, a}, 3] + # &` (which could be defined alternatively as foo[arg_]:=RandomReal[{-a,a},3}+ arg) is Mapped (/@) on the list x (which is a list of triples). $\endgroup$
    – kglr
    Commented Nov 30, 2020 at 17:25
  • $\begingroup$ Re "long straight line added to the random noisy lines", it may be version/os related. If you update your question with a picture showing the problem, may be someone with version 7 may be able identify a solution. $\endgroup$
    – kglr
    Commented Nov 30, 2020 at 17:28
  • $\begingroup$ Oh no ! This is weird! I get the straight lines if I use Axes -> False, or Axes -> None. Using Axes -> True removes the issue !! $\endgroup$
    – Cham
    Commented Nov 30, 2020 at 22:05
  • $\begingroup$ If I leave the option Axes -> True, but translate out the axes, the issue is back again ! This is odd. Looks like a bug to me. $\endgroup$
    – Cham
    Commented Nov 30, 2020 at 22:14

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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