How to draw a spring?

Question

I am new to Mathematica and have recently been exploring graphical animations. So I was experimenting with simple concepts in periodic motion and hence wondered how can I draw a simple spring? Is there an easier/better way to do this?

The solution I arrived at was a simple function to draw a spring between two $x$ and $y$ coordinates.

hspring[a0_, x10_, x20_] := 
 Module[{a = a0, x1 = x10, x2 = x20, n = 100},
  h = (x2 - x1)/n;
  xvalues = Table[k, {k, x1, x2, h}];
  yvalues = Table[a Sin[m Pi/2], {m, 0, n}];
  Line[Transpose @ {xvalues, yvalues}]
 ];

vspring[a0_, y10_, y20_] := 
 Module[{a = a0, y1 = y10, y2 = y20, n = 100},
  h = (y2 - y1)/n;
  yvalues = Table[k, {k, y1, y2, h}];
  xvalues = Table[a Sin[m Pi/2], {m, 0, n}];
  Line[Transpose @ {xvalues, yvalues}]
 ];

Manipulate[
 Graphics[{hspring[0.2, 0, Abs[2 Sin[x]]], Red, PointSize[0.03], 
   Point[{Abs[2 Sin[x]], 0}]}, PlotRange -> {{0, 3}, {-1, 1}}], 
  {x, 0.01, 2 Pi, 0.1}]

Answer 1

A textbook-like animation

turns = 10;  
aa = Table[Framed@ 
 Show[ParametricPlot3D[
          Piecewise[{{{1, x, 0}, x <= 0}, 
                    {{Cos[2 Pi turns x/r], x, Sin[2 Pi turns x/r]}, 0 < x <= r}, 
                    {{1, x, 0}, x > r}}], 
        {x, -.5, r + .5}, 
        PlotStyle  -> {Gray, Specularity[Gray, 10]}, Lighting -> "Neutral", 
        PlotPoints -> 100,  MaxRecursion -> 3, 
        PlotRange  -> {{-10, 10}, {-1, 15}, {-5, 5}}, 
        Axes       -> None,  Boxed -> False, Method -> {"TubePoints" -> 30}, 
        ViewPoint  -> {10000, 1, 5}] /. Line[pts_, rest___] :> Tube[pts, 0.2, rest],
     Graphics3D[Sphere[{1, r + 1, 0}, 1.25]]], {r, Table[15/2 - 5/2 Cos@x, {x, 0, Pi, .1}]}];
Export["C:\\test.gif", Join[aa, Reverse@aa]]

Answer 2

In 3D you can use a spiral:

spring3D[height_, n_, opts___] :=
 ParametricPlot3D[
   {Cos[n 2 Pi t], Sin[n 2 Pi t], height t},
  {t, 0, 1},
  Boxed -> False, Axes -> False,
  opts]

Answer 3

I propose a bit more compact solution:

spring[r_: {1, 0}, n_: 20, w_: 1] := Line@Transpose[{r, -Cross[r]}.{(# - 1)/(2 n), 
      Re[I^#] w/Norm[r]}] &@Range[2 n + 1];

Here r is the vector of the spring. The default value {1, 0} corresponds to the horizontal unit-length spring. n is the number of half-waves and w is the width of the spring.

You can play with it with Locator:

Manipulate[Graphics[spring[r], PlotRange -> 5], {{r, {1, 1}}, Locator}]

Notes:

1. Cross[r] rotates r by 90 degrees.
2. {r, -Cross[r]} is the rotation transform.
3. Instead of Re[I^#] you can use Sin, TriangleWave, etc.

Answer 4

The drawings by @Peltio reminded me of the way my high school teacher drew coils so I have opted for faking the 3d effect. Essentially, a squinted cycloid curve loos like a coil under perspective:

With[{stretch = 2, revs = 8}, 
 ParametricPlot[{.1 stretch ((2) t revs - 
       Sin[2 π t revs + π/2]) + .1 stretch, (1 - 
     Cos[2 π  t revs + π/2])}, {t, 0, 1}]]

which is OK, but the lines crossing ruins the 3D effect. A way to amend that is by generating a set of allowed ranges for the parameter along the cycloid and wrapping the whole thing in a function:

    coilFunc[revs_, stretch_, t_] := 
 Block[{range, gap = .055, gapPos = 1.12, plhold},
  range = {{0, gapPos - gap}}~Join~
    Table[{i + gapPos + gap, i + gapPos - gap + 1}, {i, 0, revs}];
  range = range/revs;
  If[Or @@ ((#1 < t < #2) & @@@ range), 
      {.1 stretch ((2) t revs -  Sin[2 π t revs + π/2]) + .1 stretch, 
      (1 -  Cos[2 π  t revs + π/2])}]
  ]

the values of the parameters gap and gapPos are what I found aesthetically pleasing. Now, you can play with it:

Manipulate[
 Show[{ParametricPlot[coilFunc[8, 2 + Sin[g], t], {t, 0, 2}, 
   PlotStyle -> Thick,
   PlotRange -> {{0, 10}, All}]}]
 , {g, 0, π}]

but to properly fake 3d, one needs to amend the ColorFunction appropriately. So the following is the above code with the added option ColorFunction -> {Hue[1 - 3 Mod[.1 - #3, 1/8] ] &}]. I call it "the psychedelic spring":

Answer 5

This is yet another way of doing it, albeit not as elegant as ybeltukov's. My mind is simple and I try to do one step at the time. So, here is a unit spring with n coils and 'aspect ratio' (width with respect to the unit length) h:

unitSpringPoints[n_, h_] := Block[{dl, xlist, ylist}, 
    dl = 1/(2  n + 1);
    xlist = Flatten[{0, 1.5 dl, dl Table[k, {k, 2, 2 n - 1}], 1 - 1.5 dl, 1}];
    ylist = Flatten[{0, 0, h/2 Table[(-1)^(k + 1), {k, 2, 2  n - 1}], 0, 0}];
    Transpose[{xlist, ylist}]
  ]

This is a spring connecting {0,0} and {1,0} with two small horizontal segment at the end points (that is the reason for generating two separate lists). To show the spring just wrap a Line around the generated points, like this

Show[Graphics[Line[unitSpringPoints[5, 0.25]]]]

Next I defined a function to transform coordinates in order to produce a spring between two given points {x0,y0} and {x1,y1}. Since this is very old code, I defined my own transformation matrix as in

coordinateTrasformMatrix[{x0_, y0_}, {x1_, y1_}] := Block[{theta},
    theta = ArcTan[x1-x0,y1 - y0];
    {{Cos[theta], -Sin[theta]}, {Sin[theta], Cos[theta]}}
]

(EDIT: I incorporated a suggestion received on MMA SE to use the two-arguments form of ArcTan in orderd to avoid Indeterminate results for the case x0==x1). And then I used it to transform the coordinates of the points of the the unit spring in those of the points of the spring between the given points

coordinateTransform[coords_List, {{x0_, y0_}, {x1_, y1_}}] := Block[{scale, mat},
    scale = Sqrt[(x1 - x0)^2 + (y1 - y0)^2];
    mat = coordinateTrasformMatrix[{x0, y0}, {x1, y1}];
    ({x0, y0} + mat .({scale, 1}*#)) & /@ coords
    ]

Then, a spring with n coils and aspect ratio h between points {x0,y0} and {x1,y1} would be given by

spring[{{x0_,y0_},{x1_,y1_}},n_:8, h_:.25]:=
      Line[ coordinateTransform[ unitSpringPoints[n, h], {{x0, y0}, {x1, y1}}]]

For example:

Show[ Graphics[ spring[{{2, 2}, {3,3}}, 5, 0.25] ], AspectRatio -> Automatic]

Sample animation (not tested, adapted from old code):

Do[ Show[ 
        Graphics[ spring[{ {2, 2}, {3 + .5Cos[t], 2 + .8Sin[t]} }] ], 
        AspectRatio -> Automatic, PlotRange -> {{1, 5}, {1, 5}}
    ], {t, 0, 6.3, .1}
]

---

Some wishing

Back then I planned to replicate the shape of the springs shown in Crawford's "Waves", the third volume of the Berkeley Physics series

(I really liked the way springs are drawn there). I planned to act on the unit spring to produce the minimal set of points required for a fast but smooth interpolation, but never found the time to complete it. Perhaps someone - who knows how springs are drawn in Craword's "Waves" has a more straightforward and (possibly) elegant solution for that.

And, since we are at it, here is another spring shape I find very visually appealing. Those from Alonso and Finn's "Fundamental University Physics"

It would be nice to turn this post (the OP's) in a resource of code to draw springs in various styles (from essential to stylish or presentation-ready) and computational load (because if one wants to model a series of say 40 coupled pendulums to see how an exponential wave develop, you need something fast to draw).

Answer 6

Here's a version, that like Peltio's takes vector end points, but uses a Sin[] curve, and has an optional fraction drawn as a line.

ClearAll[spring]
spring::usage = "spring[ point1, point2, numberOfTurns, height, fractionToDrawAsLinesAtEnds ]" ;
spring[ a1_List, a2_List, n_: 8, h_: .25, f_: 0.1 ] := Module[{n1, d, nd, r, r1 },
  n1 = Norm[a1] ;
  d = a2 - a1 ;
  nd = Norm[d] ;
  r = RotationMatrix[ArcTan @@  d ] ;
  r1 = r . {n1, 0} ;
  ParametricPlot[
   {
    {a1 - r1 + r . { n1 + nd f + t (1 - 2 f) nd, h Sin[ 2 Pi n t]}},
    {a1 - r1 + r . { n1 + nd f + (1 - 2 f) nd + t f nd, 0}},
    {a1 - r1 + r . { n1 + t f nd, 0}}
    }
   , {t, 0, 1 }
   , Epilog -> { Point[{a1, a2}]}
   ]
  ]

spring[ {1, 2}, {3, 5} ]

Answer 7

Here's the 2D curly one wrapped up like a graphics primitive.

Spring2D[start_, end_, loops_, radius_] := 
 Module[{detail = 40, steps}, steps = detail (loops + .5); 
  Translate[
   Rotate[Line@
     Table[{radius + (Norm[end - start] - 2 radius) a/steps + 
        radius Cos[2 Pi a/detail + Pi], 
       radius Sin[2 Pi a/detail]}, {a, 0, steps}], {{1, 0}, 
     end - start}], start]]

Manipulate[
 Graphics[Spring2D[p1, p2, loops, radius], 
  PlotRange -> 5], {{p1, {-2, 0}}, Locator}, {{p2, {2, 0}}, 
  Locator}, {{loops, 8}, 4, 20, 1}, {{radius, .5}, .2, 2}]

Answer 8

I typically use the "raw" Graphics and Graphics3D functions because it's easier to combine multiple objects that way. If you simply want a quick and dirty way to produce the point set for drawing a squiggly (Sin) line betwee two arbitrary points, this may be of use. The number of turns is intended to be an integer. Making it negative reverses the orientation of the coils.

Clear[springPoints]
springPoints::usage = 
  "springPoints[radius, \
numberOfTurns,numberOfPoints][{x0,y0},{xL,yL}]";
springPoints[r_, n_, \[Rho]_][P0_, PL_] := Module[{tHat, nHat, L},
  L = Norm[PL - P0];
  tHat = Normalize[PL - P0];
  nHat = {-tHat[[2]], tHat[[1]]};
  P0 + tHat L # + r Sin[#  n 2 \[Pi]] nHat & /@ Range[0, 1, 1/\[Rho]]
  ] 

Clear[Ps10, Ps1L, Ps20, Ps2L, \[CapitalDelta]P, r, n1, n2, \[Rho], \
s1, s2]
r = .25; \[Rho] = 100;
Ps10 = {0, 0}; Ps1L = 5 {1, 1}; n1 = 8;  
Ps20 = Ps1L; Ps2L = Ps20 + Ps1L; n2 = -10;
\[CapitalDelta]P = {-1, Sqrt[2]}; 
s1 = springPoints[r, n1, \[Rho]];
s2 = springPoints[r, n2, \[Rho]];
Graphics[{
  {Dashing[.002]
   , Line@s1[Ps10, Ps1L]
   , Line@s2[Ps20, Ps2L]}
  , {Line@s1[Ps10, Ps1L + \[CapitalDelta]P]
   , Line@s2[Ps20 + \[CapitalDelta]P, Ps2L]}
  , Point[{Ps10, Ps1L, Ps20, Ps2L, Ps1L + \[CapitalDelta]P}]
  }]

Answer 9

Slightly modify Peeter Joot's code to include the case when f (length of end of spring) is zero:

...
If[f>0,
    ParametricPlot[ ... ],
    ParametricPlot[a1-r1+r.{n1+nd f+t (1-2 f) nd,h TriangleWave[n t]},{t,0,1}]
]

After modification, you can make arbitary curve a spring:

pts3 = Table[{t, t^2}, {t, -1, 1, 0.1}];
tuples = Partition[pts3, 2, 1];
final = Map[(spring[#[[1]], #[[2]], 3, 0.02, 0][[1, 1]]) &, tuples];
Plot[-t^2, {t, -1, 1},
    Epilog -> Line[Flatten[Cases[final, _Line, Infinity] /. Line -> Identity, 1]],
    PlotRange -> {-1, 1}, 
    AspectRatio -> 0.8*GoldenRatio
]