Message Boards Message Boards


Convert Arbitrary 2D Curve to Spring

Posted 6 months ago
0 Replies
4 Total Likes

Please download the attached notebook for the complete demo

The work in this discussion is inspired by the SE link and a domestic user's question on how to construct the following plot from Wolfram Language:


This graph is composed of several sections

  • Top and bottom dome
  • Dark region on the left and lower part
  • Zigzaged contour/boudary for the dome
  • Light colored region on the left with triangular boundary
  • Light colored region on the middle with triangular boundary, pointing upward
  • Mesh lines
  • A bunch of rays shooting from the origin

If you plot the sections separatedly and put everything in the right order in terms of graphical layer,


you have a futuristic and stylish plot below with Epilog -> ZigZagLine in the final Show function:


Chromatists can suggest a better palette something like Chanel's Morandi scheme:


Here is how to draw the zig zag lines (other components are not discussed here):

  • Please find the Spring[...] function in the attached notebook or here. I have modified the SE version to reduce the lines produced when the end length of a spring is set to zero. Quickly test on the example:

     pts1 = 2*{{-1, 0}, {0, 1}, {1, 0}, {0, -1}, {-1, 0}};
     pts2 = ConstantArray[{4, 0}, 5] + pts1;
       Line[pts1], Line[pts2],
       spring[pts1[[2]], pts2[[2]]][[1]],
       spring[pts1[[4]], pts2[[4]]][[1]]


To draw a spring curve for a curve with closed form solution, say a parabola, You can use the following procedure. The key steps are

  • Team up the point and its neighbour on the right, resulting Length[pts3] - 1 tuples:

     pts3 = Table[{t, t^2}, {t, -1, 1, 0.08}];
     tuples = Partition[pts3, 2, 1];
  • Connect two points on the parabola with spring in between. Flatten the list of lines and join all points in a list:

    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]


For implicity function like hyperbola, you can do the following to extract the points on curve:

line1 = Table[{x, 
    y /. FindRoot[y^2 - x^2 - 1 && y > 0, {y, 1}]}, {x, -2, 2, 0.2}];
line2 = line1 /. {{a_, b_} :> {a, -b}};
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
or Discard

Group Abstract Group Abstract