wolfram-mathematica - 将平滑曲线放入管内

Question

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


(来源: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]

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]    

当你放大图像时，这个缩放得很好(以前的没有)