Как вы решаете для положительных корней функции и нарисуете их как точки на графике функции в математике?

Question

Я пытаюсь нарисовать следующую функцию и указать на графике, где функция проходит на 45 градусов. Я был в состоянии построить график самой функции, используя следующий код:

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[a[h], {h, 0, 4}, PlotRange -> {{0, 4}, {0, -4}}, AspectRatio -> 1] 

мне нужно, чтобы отобразить точку на каждой кривой, где наклон превышает 45 градусов. Тем не менее, я до сих пор не смог даже решить проблему с числами, из-за чего-то странного в отношении использования таблиц в функциях Solve и Reduce. Я пробовал:

Reduce[{a'[h] == Table[-1, {Dimensions[a[h]][[1]]}], h >= 0}, h] 

Но я, видимо, не может сделать это с такой функцией, и я не знаю, как добавить эти результаты на участке таким образом, что каждая строка получает метку, где она пересекает. Кто-нибудь знает, как это настроить?

Answer 1

Вот ваш код, для полноты картины, с параметрами участок слегка изменен, чтобы увеличить в интересующей области:

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}] 

Edit:

В ответ на просьбу режущих участков в найденных точках - вот один из способов:

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]}]] 

, и это должно быть выполнено после решения были найдены.

Answer 2

могли бы найти точки с помощью:

slope45s = 
h /. Map[First[Solve[D[#, h] == -1 && h >= 0, h]] &, a[h]] 

Out [12] = {0,623422, 0,415615, 0,311711, 0,249369, 0,207807, 0,178121, \ 0,155856}

Здесь мы собрали список соответствующие моменты.

pts = Transpose[{slope45s, Tr[a[slope45s], List]}] 

Теперь можно построить любое количество способов. Вот один из них.

p2 = ListPlot[pts, PlotRange -> {{0, 4}, {0, -4}}, 
    PlotStyle -> {PointSize[.01], Red}]; 
p1 = Plot[a[h], {h, 0, 4}, PlotRange -> {{0, 4}, {0, -4}}, 
    AspectRatio -> 1]; 

Показать [p1, p2]

(Будучи новым в современном world-- или, вернее, в том возрасте связано с более ранним civilization-- я не знаю, как вставить в изображение.)

(Хорошо, спасибо Леонид. Я думаю, что у меня есть изображение, а также с отступом кода.)

(Но почему мы говорим в круглых скобках ??)

Daniel Лихтблау Wolfram Research

Edit: я не сделал так же, как картина, которую я дал. Вот один, я думаю, более описателен.

makeSegment[pt_, slope_, len_] := 
Rotate[Line[{pt + {-len/2, 0}, pt + {len/2, 0}}], ArcTan[slope]] 

p2 = ListPlot[pts, PlotStyle -> {PointSize[.01], Red}]; 
p1 = Plot[a[h], {h, 0, 4}, PlotRange -> {{0, 2}, {0, -1}}, 
    AspectRatio -> 1]; 
p3 = Graphics[Map[{Orange, makeSegment[#, -1, .2]} &, pts]]; 

Show[p1, p2, p3, AspectRatio -> 1/2, ImageSize -> 1000]