在管内放置光滑的曲线

时间:2010-11-30 07:41:35

标签: wolfram-mathematica

用指定的起点和终点绘制平滑曲线并限制在下面的分段线性管内是什么好方法?

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]

1 个答案:

答案 0 :(得分:4)

也许是这样的:

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

通过添加/删除Bezier的控制点,您可以更好地控制路径。我记得“Bspline包含在其控制点的凸包中”,因此您可以在粗线内添加控制点(例如,在实际点集中的中间点上下),以便越来越多地限制Bezier。

修改

以下是第一次尝试绑定曲线。糟糕的编程,只是为了了解可以做些什么:

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

编辑2

或者更好的是:

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

alt text

当你放大图像时(前面的那些没有),这个可以很好地扩展。