绘制曲线边缘的箭头
受ask.sagemath这个问题的启发,在由Plot
, ContourPlot
等生成的曲线末端添加箭头的最佳方式是什么? 这些是高中时看到的情节类型,表明曲线在页面末尾延续。
经过一番搜索之后,我无法找到一个内置方式或最新的包来做到这一点。 (有ArrowExtended,但很旧)。
ask.sagemath问题中给出的解决方案依赖于函数及其终点的知识以及(可能)获取衍生物的能力。 它翻译成Mathematica是
f[x_] := Cos[12 x^2]; xmin = -1; xmax = 1; small = .01;
Plot[f[x],{x,xmin,xmax}, PlotLabel -> y==f[x], AxesLabel->{x,y},
Epilog->{Blue,
Arrow[{{xmin,f[xmin]},{xmin-small,f[xmin-small]}}],
Arrow[{{xmax,f[xmax]},{xmax+small,f[xmax+small]}}]
}]
另一种方法是简单地用Arrow[]
替换由Plot[]
生成的Line[]
对象。 例如
Plot[{x^2, Sin[10 x], UnitStep[x]}, {x, -1, 1},
PlotStyle -> {Red, Green, {Thick, Blue}},
(*AxesStyle -> Arrowheads[.03],*) PlotRange -> All] /.
Line[x__] :> Sequence[Arrowheads[{-.04, .04}], Arrow[x]]
但是,这有一个问题,即线条中的任何不连续部分都会生成箭头,而您不需要它们(这通常可以通过“ Exclusions -> None
”选项来修复)。 更重要的是,这种方法对于CountourPlot
是无望的。 例如尝试
ContourPlot[x^2 + y^3 == 1, {x, -2, 2}, {y, -2, 1}] /.
Line[x__] :> Sequence[Arrowheads[{-.04, .04}], Arrow[x]]
(上述情况中的问题可以通过规则来解决,例如{a___, l1_Line, l2_Line, b___} :> {a, Line[Join[l2[[1]], l1[[1]]]], b}
或使用适当的单头箭头)。
正如你所看到的,上述(快速入侵)都不是特别强大或灵活。 有人知道一种方法吗?
以下似乎工作,首先排序段:
f[x_] := {E^-x^2, Sin[10 x], Sign[x], Tan[x], UnitBox[x],
IntegerPart[x], Gamma[x],
Piecewise[{{x^2, x < 0}, {x, x > 0}}], {x, x^2}};
arrowPlot[f_] :=
Plot[{#}, {x, -2, 2}, Axes -> False, Frame -> True, PlotRangePadding -> .2] /.
{Hue[qq__], a___, x___Line} :> {Hue[qq], a, SortBy[{x}, #[[1, 1, 1]] &]} /.
{a___,{Line[x___], d___, Line[z__]}} :>
List[Arrowheads[{-.06, 0}], a, Arrow[x], {d},
Arrowheads[{0, .06}], Arrow[z]] /.
{a___,{Line[x__]}}:> List[Arrowheads[{-.06, 0.06}], a, Arrow[x]] & /@ f[x];
arrowPlot[f]
受到Alexey的评论和belisarius的回答的启发,这是我的尝试。
makeArrowPlot[g_Graphics, ah_: 0.06, dx_: 1*^-6, dy_: 1*^-6] :=
Module[{pr = PlotRange /. Options[g, PlotRange], gg, lhs, rhs},
gg = g /. GraphicsComplex -> (Normal[GraphicsComplex[##]] &);
lhs := Or@@Flatten[{Thread[Abs[#[[1, 1, 1]] - pr[[1]]] < dx],
Thread[Abs[#[[1, 1, 2]] - pr[[2]]] < dy]}]&;
rhs := Or@@Flatten[{Thread[Abs[#[[1, -1, 1]] - pr[[1]]] < dx],
Thread[Abs[#[[1, -1, 2]] - pr[[2]]] < dy]}]&;
gg = gg /. x_Line?(lhs[#]&&rhs[#]&) :> {Arrowheads[{-ah, ah}], Arrow@@x};
gg = gg /. x_Line?lhs :> {Arrowheads[{-ah, 0}], Arrow@@x};
gg = gg /. x_Line?rhs :> {Arrowheads[{0, ah}], Arrow@@x};
gg
]
我们可以在一些函数上测试这个
Plot[{x^2, IntegerPart[x], Tan[x]}, {x, -3, 3}, PlotStyle -> Thick]//makeArrowPlot
并在一些等高线图上
ContourPlot[{x^2 + y^2 == 1, x^2 + y^2 == 6, x^3 + y^3 == {1, -1}},
{x, -2, 2}, {y, -2, 2}] // makeArrowPlot
一个失败的地方就是在图的边缘有水平线或垂直线。
Plot[IntegerPart[x],{x,-2.5,2.5}]//makeArrowPlot[#,.03]&
这可以通过诸如PlotRange->{-2.1,2.1}
或Exclusions->None
选项来修复。
最后,增加一个选项会很好,因此每个“曲线”只能在它们的边界上箭头。 这会给像Belisarius的答案那样的情节(它也会避免上面提到的问题)。 但这是一个品味问题。
下面这个构造的优点是不会搞乱Graphics结构的内部结构,并且比ask.sagemath中提出的更加通用,因为它更好地管理PlotRange和infinities。
f[x_] = Gamma[x]
{plot, evals} =
Reap[Plot[f[x], {x, -2, 2}, Axes -> False, Frame -> True,
PlotRangePadding -> .2, EvaluationMonitor :> Sow[{x, f[x]}]]];
{{minX, maxX}, {minY, maxY}} = Options[plot, PlotRange] /. {_ -> y_} -> y;
ev = Select[evals[[1]], minX <= #[[1]] <= maxX && minY <= #[[2]] <= maxY &];
seq = SortBy[ev, #[[1]] &];
arr = {Arrow[{seq[[2]], seq[[1]]}], Arrow[{seq[[-2]], seq[[-1]]}]};
Show[plot, Graphics[{Red, arr}]]
编辑
作为一项功能:
arrowPlot[f_, interval_] := Module[{plot, evals, within, seq, arr},
within[p_, r_] :=
r[[1, 1]] <= p[[1]] <= r[[1, 2]] &&
r[[2, 1]] <= p[[2]] <= r[[2, 2]];
{plot, evals} = Reap[
Plot[f[x], Evaluate@{x, interval /. List -> Sequence},
Axes -> False,
Frame -> True,
PlotRangePadding -> .2,
EvaluationMonitor :> Sow[{x, f[x]}]]];
seq = SortBy[Select[evals[[1]],
within[#,
Options[plot, PlotRange] /. {_ -> y_} -> y] &], #[[1]] &];
arr = {Arrow[{seq[[2]], seq[[1]]}], Arrow[{seq[[-2]], seq[[-1]]}]};
Show[plot, Graphics[{Red, arr}]]
];
arrowPlot[Gamma, {-3, 4}]
仍然在想ListPlot和al的更好。
链接地址: http://www.djcxy.com/p/20247.html上一篇: Plotting arrows at the edges of a curve
下一篇: VertexCoordinate Rules and VertexList from GraphPlot Graphic