Задача полного исследования функции с помощью методов математического анализа является крайне важной и в целом весьма сложной задачей, так как она требует большого количества вычислений и знаний по работе с понятиями математического анализа (вычисление производных, пределов), решения уравнений, неравенств, сравнения между собой чисел и многое другое.
В данном посте я привожу созданные мной функции для поиска всех необходимых значений и свойств произвольной функции. Все функции, созданные для данного поста реализованы в системе Mathematica, что еще раз демонстрирует безграничную мощь, гибкость и простоту использования этого матического пакета.
Область определения функции
DefinitionDomain[expr_, variable_:x]:=If[Head[#]===List, #, List[#]]&@(Reduce[Element[expr, Reals]&&Denominator[expr]!=0, variable, Reals]/.Or->List)
В 10-й версии Wolfram Language появилась встроенная функция FunctionDomain
.
{DefinitionDomain[Cos[x]/x, x], FunctionDomain[Cos[x]/x, x]}

Область значений функции
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
.
{RangeValues[x/(x+1), x], FunctionRange[x/(x+1), x, y]}

Выяснение того, к какому классу функций — четных или нечетных, принадлежит функция
OddEvenTest[expr_, variable_:x]:=If[FullSimplify[expr-(expr/.variable->-variable)===0], "четная", If[FullSimplify[expr+(expr/.variable->-variable)===0], "нечетная", "общего вида"]]
OddEvenTest/@{Cos[x], Sin[x], x, 1/x, x+x^2}

Периодичность функции
Periodicity[expr_, variable_]:=If[Periodic`PeriodicFunctionQ[expr, variable], {"функция периодична", Periodic`PeriodicFunctionPeriod[expr, variable]}, "функция не периодична"]
В 10-й версии Wolfram Language появилась встроенная функция FunctionPeriod
.
{Periodicity[Sin[x]+Sin[x/3], x], FunctionPeriod[Sin[x]+Sin[x/3], x]}

Поиск нулей функции (точек пересечения с осью абсцисс)
FunctionZeros[expr_, {min_, max_}, variable_:x]:=Flatten@{Reduce[expr==0, variable, Reals, GeneratedParameters->(Subscript[λ, #]&)], {#, N[#]}&@Reduce[{expr==0, min<=variable<=max}, variable, Reals]}
FunctionZeros[Cos[x]-Sin[x/2], {-2, 2}, x]
FunctionZeros[x^2-x, {2, 10}, x]


Значение функции в нуле (пересечение с осью ординат)
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]]
FunctionValueInZero[x^2+1/(x+2)]
FunctionValueInZero[Sin[x]/x]


Поиск вертикальных асимптот функции
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[]}->{}]
VerticalAsymptotes[1/x-E^-x]

Поиск наклонных и горизонтальных асимптот функции
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]])]
InclinedAsymptotes[ArcTan[2x]+x, {-5, 5}, x]
Plot[ArcTan[2x]+x, {x, -5, 5}, Epilog->%[[2]], ImageSize->400, AspectRatio->Automatic]


Поиск точек экстремума
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]}
ExtremumPoints[x^2+x^3, {-Infinity, Infinity}, x]

Поиск точек перегиба
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]}
InflectionPoints[x^2+x^3, {-Infinity, Infinity}, x]

Создание функции, создающий отчет по анализу произвольной функции
fixSize[object_, height_]:=Pane[object, {380, height}, Alignment->{Center, Center}, Scrollbars->{True, True}]
pointsFromRules[rules_, variable_:x]:=variable/.List[ToRules[rules]]
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}\)
FullFunctionAnalysis[11+x-103 x2+11-x, {-6, 6}]

Анализ функции 1496*: \(\sqrt{\frac{3+x^4}{1+x^2}}\)
FullFunctionAnalysis[3+x41+x2, {-6, 6}]

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

Анализ функции 1506: \(e^{2x-x^2}\)
FullFunctionAnalysis[E2 x-x2, {-3, 3}]

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

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

Анализ функции 1530*: \(\frac{e^{\frac{1}{1-x^2}}}{1+x^2}\)
FullFunctionAnalysis[E11-x21+x2, {-7/2, 7/2}]

- Еще несколько примеров: некоторые произвольные функции, например, \(\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}\)
FullFunctionAnalysis[Cos[x] Cos[2 x] Cos[3 x], {-10, 10}]

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

- Построенные функции позволяют производить анализ функции, содержащей один и более произвольных параметров
FullFunctionAnalysis[ab + x^2, {-6, 6}, False]

- Также функции могут содержать специальные функции, например функцию Бесселя
FullFunctionAnalysis[BesselJ[0, x], {0, 20}]

Оставить комментарий