Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

This is a question based on this answer by halirutan.

Some amazing images can be created with this code, and I was wondering whether it was possible to extend the principle to different shapes.

I would like to create images based on the sculptures of Naum Gabo & Barbara Hepworth as shown below:

Below is an image made with halirutan's code, included to clarify the similarity:

x = 50; drawMe@Table[Mod[i, x], {i, E x}]

My question is threefold really. Is it possible to :

  • extend this principle to other shapes?
  • extend this to 3D?
  • distort the shapes with a mesh distort or similar (see image below)?
  • share|improve this question
        
    I think this is not related to Graph as you're never using any of the non-trivial layout algorithms. I'd draw these using Graphics primitives only, not Graph. –  Szabolcs Mar 27 at 15:15
        
    OK - title changed accordingly –  martin Mar 27 at 15:17
    1  
    New mesh-based geometry might be useful. –  István Zachar Mar 27 at 20:25
        
    What version does this work on? Can't seem to get anything from it :/ –  martin Mar 27 at 22:00
        
    Just seen - version 10 –  martin Mar 27 at 22:14
    add comment

    3 Answers 3

    up vote 18 down vote accepted

    I think you should not be looking at Graph, which is for graph plotting. This is really a graphics question.

    Looking at your example, I see one or more curves split into (equal?) segments, and then the division points connected with straight lines.

    So we can base this on this answer (please check there for the code).

    After dividing a single curve into 150 segments (using the referenced answer, just change the /20 to /150 in the Table's step size), I can get the actual division points:

    pts = fun /@ times;
    

    Find a nice way to connect them:

    Manipulate[
     Graphics3D@Line@Transpose[{pts, RotateLeft[pts, shift]}],
     {shift, 1, Length[pts] - 1, 1}
    ]
    

    And obtain figures like this:

    Show[
     ParametricPlot3D[fun[t], {t, 0, 2 Pi}, PlotStyle -> Black],
     Graphics3D@Line@Transpose[{pts, RotateLeft[pts, 96]}],
     Boxed -> False, Axes -> False
    ]
    

    share|improve this answer
    1  
    Beautiful! Also pts for fun times! –  Jacob Akkerboom Mar 27 at 21:36
        
    @ Szabolcs, this is really great - beautiful indeed! I had a look at the evenly spaced points on a curve previously, but was unable to even come close (hence not posting!) - thanks again - will have a go at playing around with your code now :) –  martin Mar 27 at 21:42
        
    @martin I didn't copy that code over here, but just ask if you have trouble with it! –  Szabolcs Mar 27 at 21:47
        
    No trouble at all - beautiful - really beautiful! :) –  martin Mar 27 at 21:48
    2  
    Nice work! We need some color and opacity for fun :) –  s.s.o Mar 27 at 22:01
    show 2 more comments

    I have made several pictures very similar to this, using code similar to the one below:

    MakePic[f_, g_, off_, nlines_, col_, dim_] := Module[{g1, cf, lines},
       g1 = ParametricPlot[{f[t], g[t + off]}, {t, 0, 2 Pi}, 
         AspectRatio -> 1, Axes -> None, 
         PlotStyle -> {{col, Thick, Opacity[0.2]}}];
       lines = Line@Table[{f[t], g[t + off]}, {t, 0, 2 Pi, 2 Pi/nlines}];
       Show[Graphics[{Opacity[0.2], col, lines}], g1, 
        Background -> Darker[col, 0.85], ImageSize -> dim]
       ];
    
    f[t_] := {2 Cos[t] - 3 Cos[4 t], Sin[t] - 4 Sin[t]};
    g[t_] := {3 Cos[3 t] - Cos[2 t] - 2, 2 Sin[t] - Sin[2 t] + 1};
    (*  600 is the number of lines... *)
    pic = 
     MakePic[f, g, 15.6, 600, RGBColor[0.8, 0.8, 1], {800, 600}]
    

    Here is a gallery on my personal webpage.

    enter image description here

    share|improve this answer
        
    +1 great :) I've added a picture from your gallery, hope you don't mind. –  Kuba Mar 28 at 20:12
        
    Thanks! Absolutely not, I was just a bit lazy to add it myself :) –  Paxinum Mar 28 at 20:16
        
    +1 Very neatly done. Added here: pinterest.com/vitaliykaurov/wolfram-language –  Vitaliy Kaurov Mar 28 at 20:17
        
    Nice to have some colour! Reminds me of nylon stretched over wire frame (check out Vessna Perunovich's work) :) –  martin Mar 28 at 22:39
        
    Some really beautiful, ghostly images :) –  martin Mar 28 at 22:58
    add comment

    A highly related concept would be envelope. Ruled surface could be a possible generalization to 3D. A simple way to find a family of lines given thier envelope curve is to use its tangent line family.

    Example 1:

    Suppose we have a curve describe in parameter u:

    pt = {Cos[u/2] Cos[u], Cos[u/2] Sin[u], .8 Sin[u]};
    ParametricPlot3D[pt, {u, 0, 4 π}]
    

    target curve

    So its tangent vector at point u can be obtained by:

    tang = #/Sqrt[#.#] &@D[pt, u];
    

    and the corresponding tangent line (with length 10 on both sides):

    tangline = pt + tang # & /@ {-2, 2};
    

    Draw the tangent lines at different u should give us a primary result:

    Needs["NumericalCalculus`"]
    Table[
          Map[NLimit[#, u -> udis] &, tangline, {2}],
          {udis, Rescale[Range[200], {1, 200}, {0, 4 π}]}
         ] //
       Graphics3D[{Line[#], Line[#[[All, 2]]], Line[#[[All, 1]]]}] &
    

    result envelope

    This should work for 2D curves, too.

    Edit:

    Another approach (which is basically the same method with Szabolcs), where the boundary line(s) is(are) given and the envelope is to be determined, is to draw segment between two points on boundary line(s). While the endpoints travel on boundary line(s) continuously and smoothly, the corresponding segment will travel continuously and smoothly in the 3D space, leaving an envelope (which in general is not a line as the above example, but a surface).

    Example 2:

    pt1 = {Sin[u], Cos[u] Sin[u], -Cos[u] Cos[u]};
    pt2 = {Cos[u/2] Cos[u], Cos[u/2] Sin[u], 1 + .5 Sin[2 u]};
    
    boarders = ParametricPlot3D[{pt1, pt2}, {u, 0, 4 π}, PlotStyle -> Directive[AbsoluteThickness[3], Brown]];
    
    Table[Evaluate[
                   {pt1 /. u -> 2 π t, pt2 /. u -> 4 π t}
                  ],
          {t, 0, 1, 1/200}] //
       Show[{Graphics3D[Line[#]], boarders}] &
    

    result envelope 2

    Example 3:

    boarders = ParametricPlot3D[pt2, {u, 0, 4 π}, PlotStyle -> Directive[AbsoluteThickness[3], Brown]];
    
    Table[Evaluate[
                   {pt2 /. u -> 4 π t, pt2 /. u -> 4 π (t + (*shift*).4)}
                  ],
          {t, 0, 1, 1/200}] //
       Show[{Graphics3D[Line[#]], boarders}] &
    

    result envelope 3

    share|improve this answer
        
    @ Silvia, this is great :) What is especially nice is that you can generate custom curves with this as opposed to using preexisting knot data. If the curves were closed, could the tangential lines join some other part of the curve (as in Szabolcs' answer)? –  martin Mar 28 at 9:57
        
    @martin I think because of the continuity and smoothness of the original line, the endpoints of the tangential lines will be surely on another continue and smooth curve. Please see my edit. –  Silvia Mar 28 at 11:13
        
    You can use Normalize for tangent versor. +1 ofc ;) –  Kuba Mar 28 at 11:24
        
    @Kuba Thanks. Normalize on symbolic expressions always introduces Abs, which makes me nervous :P –  Silvia Mar 28 at 11:26
        
    @Silvia Agree :) –  Kuba Mar 28 at 11:28
    show 3 more comments

    Your Answer

     
    discard

    By posting your answer, you agree to the privacy policy and terms of service.

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