Исследование произвольной функции методами математического анализа в системе Mathematica

Задача полного исследования функции с помощью методов математического анализа является крайне важной и в целом весьма сложной задачей, так как она требует большого количества вычислений и знаний по работе с понятиями математического анализа (вычисление производных, пределов), решения уравнений, неравенств, сравнения между собой чисел и многое другое.

В данном посте я привожу созданные мной функции для поиска всех необходимых значений и свойств произвольной функции. Все функции, созданные для данного поста реализованы в системе Mathematica, что еще раз демонстрирует безграничную мощь, гибкость и простоту использования этого матического пакета.

Область определения функции

In[1]:=

DefinitionDomain[expr_, variable_:x]:=If[Head[#]===List, #, List[#]]&@(Reduce[Element[expr, Reals]&&Denominator[expr]!=0, variable, Reals]/.Or->List)

В 10-й версии Wolfram Language появилась встроенная функция FunctionDomain.

In[2]:=

{DefinitionDomain[Cos[x]/x, x], FunctionDomain[Cos[x]/x, x]}

Out[2]=

Исследование произвольной функции методами математического анализа в системе Mathematica

Область значений функции

In[3]:=

RangeValues[expr_, variable_:x]:=Reduce[Or@@Cases[FullForm@Flatten[Reduce[y==expr, variable, Reals]/.And|Or->List], Inequality[___, y, ___]|LessEqual[_, y, _]|Less[_, y, _]|y<=_|y>=_|y>_|y<_|y==_, Infinity], y, Reals]

В 10-й версии Wolfram Language появилась встроенная функция FunctionRange.

In[4]:=

{RangeValues[x/(x+1), x], FunctionRange[x/(x+1), x, y]}

Out[4]=

Выяснение того, к какому классу функций — четных или нечетных, принадлежит функция

In[5]:=

OddEvenTest[expr_, variable_:x]:=If[FullSimplify[expr-(expr/.variable->-variable)===0], "четная", If[FullSimplify[expr+(expr/.variable->-variable)===0], "нечетная", "общего вида"]]

In[6]:=

OddEvenTest/@{Cos[x], Sin[x], x, 1/x, x+x^2}

Out[6]=

Периодичность функции

In[7]:=

Periodicity[expr_, variable_]:=If[Periodic`PeriodicFunctionQ[expr, variable], {"функция периодична", Periodic`PeriodicFunctionPeriod[expr, variable]}, "функция не периодична"]

В 10-й версии Wolfram Language появилась встроенная функция FunctionPeriod.

In[8]:=

{Periodicity[Sin[x]+Sin[x/3], x], FunctionPeriod[Sin[x]+Sin[x/3], x]}

Out[8]=

Поиск нулей функции (точек пересечения с осью абсцисс)

In[9]:=

FunctionZeros[expr_, {min_, max_}, variable_:x]:=Flatten@{Reduce[expr==0, variable, Reals, GeneratedParameters->(Subscript[λ, #]&)], {#, N[#]}&@Reduce[{expr==0, min<=variable<=max}, variable, Reals]}

In[10]:=

FunctionZeros[Cos[x]-Sin[x/2], {-2, 2}, x]
FunctionZeros[x^2-x, {2, 10}, x]

Out[10]=

Out[11]=

Значение функции в нуле (пересечение с осью ординат)

In[12]:=

FunctionValueInZero[expr_, variable_:x]:=If[FullSimplify[And@@DefinitionDomain[expr, variable]~Join~{variable==0}]||Quiet@Check[Element[expr/.variable->0, Reals], False], {expr/.variable->0}, If[Element[#, Reals], {#, "limit"}, {"не существует"}]&@Limit[expr, x->0]]

In[13]:=

FunctionValueInZero[x^2+1/(x+2)]
FunctionValueInZero[Sin[x]/x]

Out[13]=

Out[14]=

Поиск вертикальных асимптот функции

In[15]:=

VerticalAsymptotes[expr_, variable_:x]:=Quiet@Block[{points, limits, val, val1, val2}, points=If[Head[#]===List, #, List[#]]&@(Reduce[{Element[variable, Reals]}~Join~(Not/@DefinitionDomain[expr, variable]), variable, Reals]/.Or->List);

limits=Identity@@(FullForm[points]/.{variable<val_|variable<=val_:>{{val, 1}}, variable>val_|variable>=val_:>{{val, -1}}, ((val1_<variable<val2_)|(val1_<variable<= val2_)|(val1_<= variable<val2_)|(val1_<= variable<= val2_)|(Inequality[val1_, Less, variable, Less, val2_])|(Inequality[val1_, LessEqual, variable, LessEqual, val2_])|(LessEqual[val1_, variable, val2_]):>{{val1, -1}, {val2, 1}}), (variable==val_:>{{val, 1}, {val, -1}})});

DeleteDuplicates[Flatten[If[And@@(FreeQ[Limit[expr, variable->#[[1]], Direction->#[[2]]], Infinity|DirectedInfinity]&/@#), {}, #[[;;, 1]]]&/@limits]]/.{Symbol[]}->{}]

In[16]:=

VerticalAsymptotes[1/x-E^-x]

Out[16]=

Поиск наклонных и горизонтальных асимптот функции

In[17]:=

InclinedAsymptotes[expr_, {xMin_, xMax_}, variable_:x]:=Block[{kP, bP, kN, bN, asymptotes}, (kP=Limit[exprvariable, variable->Infinity];

kN=Limit[exprvariable, variable->-Infinity];

If[NumericQ[kP], bP=Limit[expr-kP*variable, variable->Infinity];

If[NumericQ[bP], asymptotes={kP*variable+bP}, asymptotes={}], asymptotes={}];

If[NumericQ[kN], bN=Limit[expr-kN*variable, variable->-Infinity];

If[NumericQ[bN], asymptotes=Append[asymptotes, kN*variable+bN], asymptotes], asymptotes];

If[Length[asymptotes]==2, {DeleteDuplicates@asymptotes, DeleteDuplicates@{Darker@Red, Thick, Dashed, Tooltip[Line[{{xMin, asymptotes[[1]]/.variable->xMin}, {xMax, asymptotes[[1]]/.variable->xMax}}], TraditionalForm@(y==asymptotes[[1]])], Tooltip[Line[{{xMin, asymptotes[[2]]/.variable->xMin}, {xMax, asymptotes[[2]]/.variable->xMax}}], TraditionalForm@(y==asymptotes[[2]])]}}, If[Length[asymptotes]==1, {asymptotes, {Darker@Red, Dashed, Thick, Tooltip[Line[{{xMin, asymptotes[[1]]/.variable->xMin}, {xMax, asymptotes[[1]]/.variable->xMax}}], TraditionalForm@(y==asymptotes[[1]])]}}, asymptotes]])]

In[18]:=

InclinedAsymptotes[ArcTan[2x]+x, {-5, 5}, x]
Plot[ArcTan[2x]+x, {x, -5, 5}, Epilog->%[[2]], ImageSize->400, AspectRatio->Automatic]

Out[18]=

Out[19]=

Поиск точек экстремума

In[20]:=

ExtremumPoints[expr_, {min_, max_}, variable_:x]:=Flatten@{Reduce[{D[expr, variable]==0||1D[expr, variable]==0, Element[expr, Reals]}, variable, Reals, GeneratedParameters->(Subscript[μ, #]&)], {#, N[#]}&@Reduce[{D[expr, variable]==0||1D[expr, variable]==0, Element[expr, Reals], min<=variable<=max}, variable, Reals]}

In[21]:=

ExtremumPoints[x^2+x^3, {-Infinity, Infinity}, x]

Out[21]=

Поиск точек перегиба

In[22]:=

InflectionPoints[expr_, {min_, max_}, variable_:x]:=Flatten@{Reduce[{D[expr, {variable, 2}]==0||1D[expr, {variable, 2}]==0, Element[expr, Reals]}, variable, Reals, GeneratedParameters->(Subscript[ξ, #]&)], {#, N[#]}&@Reduce[{D[expr, {variable, 2}]==0||1D[expr, {variable, 2}]==0, Element[expr, Reals], min<=variable<=max}, variable, Reals]}

In[23]:=

InflectionPoints[x^2+x^3, {-Infinity, Infinity}, x]

Out[23]=

Создание функции, создающий отчет по анализу произвольной функции

In[24]:=

fixSize[object_, height_]:=Pane[object, {380, height}, Alignment->{Center, Center}, Scrollbars->{True, True}]

In[25]:=

pointsFromRules[rules_, variable_:x]:=variable/.List[ToRules[rules]]

In[26]:=

FullFunctionAnalysis[expr_, {min_, max_}, makePlot_:True, variable_:x]:=
Block[{d1, d2, FunctionZeros$, ExtremumPoints$, InflectionPoints$, FunctionValueInZero$, VerticalAsymptotes$, InclinedAsymptotes$}, 
d1=D[expr, variable];

d2=D[expr, {variable, 2}];

Panel@Grid[{{Style[Row[{"Исследование функции ", Style[TraditionalForm[expr], Red]}], FontFamily->"Myriad Pro Cond", 30]}, {If[DefinitionDomain[expr, variable]==={False}, 
Style[Row[{Style["Область значений: ", 20, Bold], Style[Row[{variable, "∈∅"}], 20, Bold], "\nФункция не определена ни в одной точке множества ,  дальнейшее иссследование невозможно"}], 20, FontFamily->"Myriad Pro Cond"], 
FunctionZeros$=FunctionZeros[expr, {min, max}, variable];

ExtremumPoints$=Quiet[ExtremumPoints[expr, {min, max}, variable]];

InflectionPoints$=Quiet[InflectionPoints[expr, {min, max}, variable]];

FunctionValueInZero$=FunctionValueInZero[expr, variable];

VerticalAsymptotes$=VerticalAsymptotes[expr, variable];

InclinedAsymptotes$=InclinedAsymptotes[expr, {min, max}, variable];

Grid[{{"Область определения:", fixSize[TraditionalForm[(DefinitionDomain[expr, variable]/.List->Or/.{Or[True]->Row[{variable, "∈"}], Or[False]->Row[{variable, "∈∅"}]})], 80]}, {"Область значений:", fixSize[TraditionalForm[Quiet[Check[RangeValues[expr, variable], "аналитические значения не удается найти"]]/.True->"y∈"], 80]}, {"Нули функции:", fixSize[TraditionalForm[FunctionZeros$[[1]]/.False->Row[{variable, "∈∅"}]/.True->Row[{variable, "∈"}]], 80]}, {Style[Row[{"Нули функции на отрезке\n[", min, ";

 ", max, "]:"}], TextAlignment->Center], fixSize[TableForm[TraditionalForm/@FunctionZeros$[[{2, 3}]]], 80]}, 
{"Функция в нуле:", fixSize[TraditionalForm[If[Length[#]==1, #[[1]], Row[{" (", expr, ")=", #[[1]]}]]], 80]&@FunctionValueInZero$}, {"Периодичность:", fixSize[If[Length[#]==0, Periodicity[expr, variable], Row[{#[[1]], "\n", "наименьший период равен ", TraditionalForm[#[[2]]]}]]&@Periodicity[expr, variable], 80]}, 
{"Четность/нечетность:", fixSize[OddEvenTest[expr, variable], 80]}, 
{"Вертикальные асимптоты:", fixSize[If[Length[#]==0, "отсутствуют", TableForm[TraditionalForm[variable==#]&/@#]]&@VerticalAsymptotes$, 80]}, {"Наклонные асимптоты:", fixSize[If[Length[#]==0, "отсутствуют", TableForm[TraditionalForm[y==#]&/@#[[1]]]]&@InclinedAsymptotes$, 80]}, {"Точки экстремума:", fixSize[If[Head[#]===Reduce, "аналитические значения не удается найти", TraditionalForm@(#/.False->Row[{variable, "∈∅"}])]&@ExtremumPoints$[[1]], 80]}, {Style[Row[{"Точки экстремума на отрезке\n [", min, ";

 ", max, "]:"}], TextAlignment->Center], fixSize[TableForm[TraditionalForm/@(ExtremumPoints$[[{2, 3}]]/.False->Row[{variable, "∈∅"}])], 80]}, {"Точки перегиба:", fixSize[If[Head[#]===Reduce, "аналитические значения не удается найти", TraditionalForm@(#/.False->Row[{variable, "∈∅"}])]&@InflectionPoints$[[1]], 80]}, {Style[Row[{"Точки перегиба на отрезке\n [", min, ";

 ", max, "]:"}], TextAlignment->Center], fixSize[TableForm[TraditionalForm/@(InflectionPoints$[[{2, 3}]]/.False->Row[{variable, "∈∅"}])], 80]}}, ItemStyle->Directive[FontFamily->"Myriad Pro Cond", 20], Background->{None, {None, {LightGray, White}}}, ItemSize->{{15, 34}, Automatic}, Alignment->{Center, Center}]]}, {Quiet@Plot[expr, {variable, min, max}, ImageSize->580, PlotStyle->Thick, ColorFunction->Function[{x, y}, If[d2>0&&d1>0, Red, If[d2<0&&d1>0, Orange, If[d2>0&&d1<0, Blue, Green]]]], PlotLegends->Placed[LineLegend[{Red, Orange, Blue, Green}, {"y'>0⋀y''>0 | \[DownArrow] \[Union]", "y'>0⋀y''<0 | \[UpArrow] \[Intersection]", "y'<0⋀y''>0 | \[DownArrow] \[Union]", "y'<0⋀y''<0 | \[UpArrow] \[Intersection]"}], Bottom], ColorFunctionScaling->False, Exclusions->expr, PlotPoints->1300, Epilog->Quiet[{{AbsolutePointSize[7], Black, Point[{#, 0}], AbsolutePointSize[3], White, Tooltip[Point[{#, 0}], {#, 0}]}&/@If[Length[FunctionZeros$[[2]]]==0, {}, pointsFromRules[FunctionZeros$[[2]]]], 
{AbsolutePointSize[9], Magenta, Point[{#, Quiet@Check[Simplify[expr/.variable->#], 10^10]}], AbsolutePointSize[5], White, Tooltip[Point[{#, Quiet@Check[Simplify[expr/.variable->#], 10^10]}], {#, Simplify[Simplify[expr/.variable->#]]}]}&/@If[Length[ExtremumPoints$[[2]]]==0, {}, pointsFromRules[ExtremumPoints$[[2]]]], 
{AbsolutePointSize[11], Brown, Point[{#, Quiet@Check[Simplify[expr/.variable->#], 10^10]}], AbsolutePointSize[7], White, Tooltip[Point[{#, Quiet@Check[Simplify[expr/.variable->#], 10^10]}], {#, Quiet@Check[Simplify[expr/.variable->#], 10^10]}]}&/@If[Length[InflectionPoints$[[2]]]==0, {}, pointsFromRules[InflectionPoints$[[2]]]], {AbsolutePointSize[7], Darker@Green, Point[{0, #}], AbsolutePointSize[3], White, Tooltip[Point[{0, #}], {0, #}]}&/@If[Length[FunctionValueInZero$]==0||Head[FunctionValueInZero$[[1]]]===String, Sequence[{}], FunctionValueInZero$], If[Length[InclinedAsymptotes$]==0, Sequence[{}], InclinedAsymptotes$[[2]]]}], GridLines->If[Length[VerticalAsymptotes$]==0, None, {VerticalAsymptotes$, None}], GridLinesStyle->Directive[Dashed, Thick, Darker@Gray], FrameTicksStyle->Directive[Bold, 14, FontFamily->"Myriad Pro Cond"], AxesStyle->Arrowheads[{0, 0.03}], AxesLabel->(Style[#, Bold, 18, Italic, FontFamily->"Myriad Pro Cond"]&/@{ToString@variable, "y"}), Frame->True]}}[[If[makePlot, All, {1, 2}]]], Alignment->{Center, Center}, Background->{None, {LightOrange, None}}, Dividers->1, ItemSize->49]]

Несколько примеров работы созданных функций

Протестируем созданные функции для проведения полного анализа произвольной функции методами математического анализа с помощью примеров из задачника Демидовича (на рисунке ниже взята страница 162 из задачника, номера ниже соответствуют номерам в задачнике).

Анализ функции 1483: \(\frac{1}{1+x}-\frac{10}{3x^2}+\frac{1}{1-x}\)

In[27]:=

FullFunctionAnalysis[11+x-103 x2+11-x, {-6, 6}]

Out[27]=

Анализ функции 1496*: \(\sqrt{\frac{3+x^4}{1+x^2}}\)

In[28]:=

FullFunctionAnalysis[3+x41+x2, {-6, 6}]

Out[28]=

Анализ функции 1504.1: \(\frac{\text{Sin}[x]}{2+\text{Cos}[x]}\)

In[29]:=

FullFunctionAnalysis[Sin[x]2+Cos[x], {-10, 10}]

Out[29]=

Анализ функции 1506: \(e^{2x-x^2}\)

In[30]:=

FullFunctionAnalysis[E2 x-x2, {-3, 3}]

Out[30]=

Анализ функции 1518: \(x\text{ArcTan}[x]\)

In[31]:=

FullFunctionAnalysis[x ArcTan[x], {-2, 2}]

Out[31]=

Анализ функции 1523*: \(\text{Log}\left[\frac{2-3x+x^2}{1+x^2}\right]\)

In[32]:=

FullFunctionAnalysis[Log[2-3 x+x21+x2], {-10, 10}]

Out[32]=

Анализ функции 1530*: \(\frac{e^{\frac{1}{1-x^2}}}{1+x^2}\)

In[33]:=

FullFunctionAnalysis[E11-x21+x2, {-7/2, 7/2}]

Out[33]=

Еще несколько примеров: некоторые произвольные функции, например, \(\text{Cos}[x]\text{Cos}\left[\sqrt{2}x\right]\text{Cos}\left[\sqrt{3}x\right]\) и \(\frac{2-x+x^2-x^3}{1+x^2}+\frac{1+x-x^2+x^3}{1+x^4}\)

In[34]:=

FullFunctionAnalysis[Cos[x] Cos[2 x] Cos[3 x], {-10, 10}]

Out[34]=

In[35]:=

FullFunctionAnalysis[2-x+x2-x31+x2+1+x-x2+x31+x4, {-6, 6}]

Out[35]=

Построенные функции позволяют производить анализ функции, содержащей один и более произвольных параметров

In[36]:=

FullFunctionAnalysis[ab + x^2, {-6, 6}, False]

Out[36]=

Также функции могут содержать специальные функции, например функцию Бесселя

In[37]:=

FullFunctionAnalysis[BesselJ[0, x], {0, 20}]

Out[37]=