完全を期すために、関心領域にズームインするようにプロットパラメータをわずかに変更したコードを次に示します。
Clear[d,h,T,f,r,a];
T = 170 Degree;
f[s_, d_] = Normal[Series[Tan[T - (d*s)], {s, 0, 4}]];
r[h_, d_] = Simplify[Integrate[f[s, d], {s, 0, h}]];
a[h_] = Table[r[h, d], {d, 1, 4, .5}];
plot = Plot[a[h], {h, 0, 4}, PlotRange -> {{0, 0.8}, {0, -0.5}},
AspectRatio -> 1, Frame -> {False, True, True, False},
FrameStyle -> Directive[FontSize -> 10],
PlotStyle -> {Thickness[0.004]}]
解(h座標)を取得するためのコードは次のとおりです。
In[42]:= solutions = Map[Reduce[{D[#, h] == -1, h >= 0}, h] &, a[h]]
Out[42]= {h == 0.623422, h == 0.415615, h == 0.311711, h == 0.249369,
h == 0.207807, h == 0.178121, h == 0.155856}
次に、プロットを作成します。
points = ListPlot[MapIndexed[{#1, a[#1][[First@#2]]} &, solutions[[All, 2]]],
PlotStyle -> Directive[PointSize[0.015], Red],
PlotRange -> {{0, 0.8}, {0, -0.5}}, AspectRatio -> 1,
Frame -> {False, True, True, False},
FrameStyle -> Directive[FontSize -> 10]]
最後に、プロットを組み合わせます。
Show[{plot, points}]
編集:
見つかったポイントでプロットをカットするという要求に応答する-ここに1つの方法があります:
plot =
With[{sols = solutions[[All, 2]]},
Plot[Evaluate[a[h]*UnitStep[sols - h]], {h, 0, 4},
PlotRange -> {{0, 0.8}, {0, -0.5}}, AspectRatio -> 1,
Frame -> {False, True, True, False},
FrameStyle -> Directive[FontSize -> 10],
PlotStyle -> {Thickness[0.004]}]]
これは、解決策が見つかった後に実行する必要があります。