円管内に滑らかな曲線を描く

Question

指定された開始点と終了点で滑らかな曲線を描き、以下のような区分線形管の内部に限定する良い方法はありますか？おそらく、

http://yaroslavvb.com/upload/save/so-tubes.png

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] 

Answer 1

このような何か：あなたはベジェのコントロールポイントを削除/追加することによって、パスを介して、より良い制御を得ることが

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] 

。 「Bsplineはコントロールポイントの凸包に含まれています」ということを覚えているので、ベジェをより拘束するために、太い線の中にコントロールポイントを追加することができます（たとえば、実際のポイントセットの中点を上下に）。

編集

次曲線をバインドする最初の試みです。

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] 

編集2

それともいっそのこと：

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

悪いプログラミングは、単に何ができるかの感覚を得るために

これは画像を拡大すると、画像が大きく伸びます（前の画像は表示されません）