Search code examples
wolfram-mathematica

Putting a smooth curve inside of a tube


What is a good way to draw a smooth curve with specified starting and ending point and restricted to be inside of a piecewise linear tube like below?


(source: yaroslavvb.com)

coords = {1 -> {0, 2}, 2 -> {1/3, 1}, 3 -> {0, 0}, 
   4 -> {(1/3 + 2)/2, 1}, 5 -> {2, 1}, 6 -> {2 + 1/3, 0}, 
   7 -> {2 + 1/3, 2}};
gp = GraphPlot[graph, VertexCoordinateRules -> coords];
pr = {{-1, 3 + 1/3}, {-1 - 1/6, 3 + 1/6}};
scale = 50;
is = -scale*(Subtract @@@ pr);
lineThickness = 2/3;
graph = {1 -> 2, 3 -> 2, 2 -> 4, 4 -> 5, 5 -> 6, 5 -> 7};
path = {3, 2, 4, 5, 7};
lp = Graphics[{Blue, Opacity[.5], 
    AbsoluteThickness[lineThickness*scale], Line[path /. coords]}];
Show[lp, gp, PlotRange -> pr, ImageSize -> is]

Solution

  • Perhaps something like this:

    coords = {2 -> {1/3, 1}, 1 -> {0, 0}, 3 -> {(1/3 + 2)/2, 1}, 
       4 -> {2, 1}, 5 -> {2 + 1/3, 2}};
    pr = {{-1, 3 + 1/3}, {-1 - 1/6, 3 + 1/6}};
    scale = 50;
    is = -scale*(Subtract @@@ pr);
    lineThickness = 2/3;
    graph = {1 -> 2, 2 -> 3, 3 -> 4, 4 -> 5};
    gp = GraphPlot[graph, VertexCoordinateRules -> coords];
    path = {1, 2, 3, 4, 5};
    
    f = BezierFunction[
       SortBy[coords /. Rule[x_, List[a_, b_]] -> List[a, b], First]];
    pp = ParametricPlot[f[t], {t, 0, 1}];
    
    lp = Graphics[{Blue, Opacity[.5], 
        AbsoluteThickness[lineThickness*scale], Line[path /. coords]}];
    Show[pp, lp, gp, PlotRange -> pr, ImageSize -> is]  
    

    alt text

    You may gain a better control over the path by adding/removing control points for the Bezier. As I remember "A Bspline is contained in the convex hull of its control points", so you can add control points inside your thick lines (up and down the middlepoints in actual point set, for example) to bound the Bezier more and more.

    Edit

    The following is a first try to bound the curve. Bad programming, just to get the feeling of what can be done:

    coords = {2 -> {1/3, 1}, 1 -> {0, 0}, 3 -> {(1/3 + 2)/2, 1}, 
       4 -> {2, 1}, 5 -> {2 + 1/3, 2}};
    pr = {{-1, 3 + 1/3}, {-1 - 1/6, 3 + 1/6}};
    scale = 50;
    is = -scale*(Subtract @@@ pr);
    lineThickness = 2/3;
    graph = {1 -> 2, 2 -> 3, 3 -> 4, 4 -> 5};
    gp = GraphPlot[graph, VertexCoordinateRules -> coords];
    path = {1, 2, 3, 4, 5};
    
    kk = SortBy[coords /. Rule[x_, List[y_, z_]] -> List[y, z], 
      First]; f = BezierFunction[kk];
    pp = ParametricPlot[f[t], {t, 0, 1}, Axes -> False];
    
    mp = Table[{a = (kk[[i + 1, 1]] - kk[[i, 1]])/2 + kk[[i, 1]],
        Interpolation[{kk[[i]], kk[[i + 1]]}, InterpolationOrder -> 1][
          a] + lineThickness/2}, {i, 1, Length[kk] - 1}];
    mp2 = mp /. {x_, y_} -> {x, y - lineThickness};
    kk1 = SortBy[Union[kk, mp, mp2], First]
    g = BezierFunction[kk1];
    pp2 = ParametricPlot[g[t], {t, 0, 1}, Axes -> False];
    
    lp = Graphics[{Blue, Opacity[.5], 
        AbsoluteThickness[lineThickness*scale], Line[path /. coords]}];
    Show[pp, pp2, lp, gp, PlotRange -> pr, ImageSize -> is]
    

    alt text

    Edit 2

    Or perhaps better yet:

    g1 = Graphics[BSplineCurve[kk1]]; 
    Show[lp, g1, PlotRange -> pr, ImageSize -> is]    
    

    alt text

    This one scales quite well when you enlarge the image (the previous ones don't)