# How to generate randomly curved and twisted strings in 3D?

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

straightString[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}];

randomStrings[s_] := Table[
straightString[s, x0[n], y0[n], z0[n], u0[n], phi0[n]], {n, 1, 40}]

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

Show[stringPack,
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: Now, I would like to modify this code to draw a pack of randomly curved and twisted "natural looking" strings. The randomization should be made while the "s" parameter is running smoothly.

Take note that I'm using a very old version of Mathematica 7.0 and I can't upgrade the machine for a newer version. So I need to use some basic functions only, nothing fancy.

• stringPack = ParametricPlot3D[randomStrings[s], {s, -20, 20}, PlotPoints -> 5, MaxRecursion -> 1] /. Line -> BSplineCurve?
– kglr
Nov 30 '20 at 15:55

SeedRandom;
Graphics3D[{RandomColor[], JoinForm["Round"], CapForm["Round"],
AbsoluteThickness, BSplineCurve@#} & /@  RandomReal[{-10, 10}, {40, 10, 3}]] Replace BSplineCurve@# with Tube @ BSplineCurve@# to get: Update: Minimal modification of your code:

SeedRandom
stringPack = ParametricPlot3D[randomStrings[s], {s, -20, 20},
PlotPoints -> 5, MaxRecursion -> 1] /.
Line[x_] :> {Hue @ RandomReal[], Thick, BSplineCurve[x]};

Show[stringPack, 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}] SeedRandom
stringPack = ParametricPlot3D[randomStrings[s], {s, -20, 20},
PlotPoints -> 3, MaxRecursion -> 1] /.
Line[x_] :> {RandomColor[], Tube @ BSplineCurve[x, SplineClosed -> True]};

Show[stringPack, Axes -> True, Ticks -> None,
AxesStyle -> Opacity[0.25], AxesOrigin -> {0, 0, 0},
SphericalRegion -> True, Method -> {"RotationControl" -> "Globe"},
ImageSize -> {700, 700}] Play with PlotPoints, MaxRecursion and SplineDegree below to explore various shapes:

SeedRandom
stringPack =
ParametricPlot3D[randomStrings[s], {s, -20, 20}, PlotPoints -> 2,
MaxRecursion -> 2] /. Line[x_] :>
{RandomColor[], Tube@BSplineCurve[x, SplineClosed -> True, SplineDegree -> 2]}; • This is a large modification of my code (complete rewrite). I would prefer a "small" modification, by adding some new random variables and functions to the original code.
– Cham
Nov 30 '20 at 15:54
• @Cham, updated with an alternative approach.
– kglr
Nov 30 '20 at 15:58
• I'm studying it. Is it possible to make the curve less random, i.e. less compact and closed on itself, and a bit more straight?
– Cham
Nov 30 '20 at 16:02
• Actually, I may be looking for some "noisy" straight paths...
– Cham
Nov 30 '20 at 16:07
• I marked your answer, but I'll have to ask a new question, since I "discovered" that it's not the effect I want to achieve. I'm looking for some randomly looking paths, a bit like a random walk. So the basic curve should be a straight line, with noise added to it.
– Cham
Nov 30 '20 at 16:32

Here is an attempt where you can specify the curvature and torsion.

The start point is chosen at random around the origin. The direction is also random.

With these data the Frenet-Serret formula is integrated by the following function:

randcurve[curvature_, torsion_] :=
Module[{ta, no, r, bi, tors, curv, inir, s, t},
eq = {ta'[s] == curv  no[s], no'[s] == -curv ta[s] + tors  bi[s],
bi'[s] == -tors no[s], r'[s] == ta[s], r == inir,
ta == inita , no == {0, 1, 0},
bi == {0, 0, 1}} /. {tors -> torsion RandomReal[],
curv -> curvature RandomReal[],
inir -> 0.3 RandomReal[{-1, 1}, 3],
inita -> ((t = RandomReal[{-1, 1}, 3])/Norm[t])};
r /. NDSolve[eq, {ta, no, bi, r}, {s, 0, 5}][]
]


You can the make a table of random curves and plot them. Here I choose a curvature and torsion of 2. You may play with these parameters as well as the parameters used inside the function:

curves[s_] = Table[randcurve[2, 2][s], 20];
ParametricPlot3D[curves[s], {s, 0, 5},
PlotRange -> {{-1, 1}, {-1, 1}, {-1, 1}}] 