(Pół) Automatyczna analiza przebiegu funkcji

Jako przykład zastosowania wiedzy i umiejętności zdobytych dotychczas zaprezentowana zostanie wspomagana komputerowo analiza przebiegu funkcji. W tradycyjnej analizie różnorodne obliczenia (granice, rozwiązywanie równań, określanie domeny i symetrii, różniczkowanie itp.)
mają na celu ,,naszkicowanie’’ wykresu funkcji i zaznaczenie na nim charakterystycznych punktów.

W programach typu Mathematica propaguje się podejście odwrotne: najpierw rysujemy wykres. Nieporozumieniem jest argumentacja, że skoro mamy już wykres to wykonanie tradycyjnych obliczeń nie ma sensu. W rzeczywistości otrzymujemy dwa źródła informacji, które muszą być konsystentne o ile tylko zadanie zostało wykonane poprawnie.

Typowe czynności wykonywane przy analizie przebiegu (wykresu) funkcji jednej zmiennej

Definicja funkcji f[x]=(x+1)/(x-1)

Funkcję możemy zdefiniować w jeden z podanych na wcześniejszych wykładach sposobów. Dalsza analiza w niewielkim stopniu zależy od sposobu definicji. Wyjątkiem są problemy wymagające użycia funkcji odwrotnych.

f[x_]:=(x+1)/(x-1)

Pierwsza czynnością powinno być sprawdzenie czy definicja działa:

f[0]

f[1]

f[E]

f[1.5]

Następnie, możemy narysować pierwszy wykres. Będziemy go ulepszać, w miarę zbobywania nowych informacji o zadanaej funkcji. Na razie wystarczającym kryterium poprawnego doboru zakresu zmiennych będzie pojawienie się na ekranie jakichkolwiek krzywych:

Plot[f[x],{x,-4,4}]

Parzystość, nieparzystość, inne symetrie

W zasadzie pierwszy wykres jasno pokazuje, że żadnych symetrii nie ma, ale dla porządku pokażę jak ich szukać, gdybyśmy ich się spodziewali. W niektórych przypadkach wystarczy sprawdzenie, czy wzór przetransformowany jest tożsamościowo równy oryginalnemu:

f[x]==f[-x]

Bardziej precyzyjnie, żądamy, aby dla każdego x wyrażenia były sobie równe. Mozna to zapisać za pomocą kwantyfikatora ogólnego ForAll (dla każdego):

ForAll[x,f[x]==f[-x]]

Usunięcia kwantyfikatorów mozna dokonać poleceniem Resolve lub Reduce:

Reduce[%,Reals]

Reduce[ForAll[x,f[x]==-f[-x]],Reals] (* sprawdzenie nieparzystości *)

Reduce[Exists[T,T≠0,ForAll[x,f[x]==f[x+T]]],Reals] (* sprawdzenie okresowości; więcej dalej ! *)

Wniosek: funkcja nie wykazuje żadnych typowych symetrii, zgodnie z wyglądem wykresu. Bardziej dociekliwy i spostrzegawczy student wykonałby taki wykres jak poniżej, gdyż Mathematica deformuje wykres (zmienia jego proporcje). Wykres o takich samych jednostkach na osiach i proporcjach ,,ekranu’’ wygląda tak:

Plot[{f[x],x},{x,-4,4},AspectRatio->1,PlotRange->{-4,4}]

Wygląda na to, że jest symetria względem prostej y=x ! To oznaczałoby, że funkcja jest sama do siebie odwrotna. Sprawdźmy to:

f[f[x]]

Simplify[%]

InverseFunction[f][x]-f[x]

Powyższe rachunki potwierdzają to co sugeruje wykres: funkcja jest sama do siebie odwrotna, a jej wykres wobec tego symetryczny względem przekątnej y=x.

Wyznaczenie dziedziny i przeciwdziedziny

W pełni automatyczna metoda ustalenia dziedziny funkcji rzeczywistej nie jest mi znana. Można spróbować zastosować jeden z poniższych trików.

dziedzina=Reduce[Evaluate[f[t]]∈Reals,t,Reals] (* ta metoda działa dla niektórych funkcji, ale tu zawodzi *)

Poniższy sposób jest formalnie poprawny, ale Mathematica nie zawsze umie rozwiązać tak postawione zadanie. Stosujemy eliminację kwantyfiktorów, do stwierdzenia, że jeżeli istnieje y∈R taki że y=f[t], to t należy do dziedziny. Zmienna t jest wolna (nie związana żadnym kwantyfikatorem), więc po usunięciu Exists powinniśmy dostać kombinację prostych wyrażeń logicznych. Po uproszczeniu będzie to szukana dziedzina:

dziedzina=Reduce[Exists[y,y==f[t]],Reals] (* inna metoda niż wyżej! *)

Wynik powyższy podaje dziedzinę, zapisaną jako 2 nierówności. Jedynym punktem nie należącym do dziedziny jest 1.

Czasem przydaje się funkcja sprawdzająca, czy dana liczba nalezy do dziedziny:

testD=Function[t,Evaluate[dziedzina]]

testD[-3]

testD[Infinity]

testD[-Infinity]

testD[1]

Podobnie możemy zapisać wyrażenie opisujące przeciwdziedzinę:

przeciwdziedzina=Reduce[Exists[t,y==f[t]],Reals]

Jak już wspomniałem, jedynym punktem ,,osobliwym’’ jest 1:

osobliwe=Reduce[Not[dziedzina]]

ToRules[osobliwe]

Poniższy zbiór punktów osobliwych posłuży ,,poprawieniu’’ wykresu (usunięciu pionowej kreski ).

exclusions=t/.%

Jedyny punkt nie należący do zbioru wartości jest równocześnie asymptotą (nie jest to reguła):

Reduce[Not[przeciwdziedzina]]

ToRules[%]

asymptP=y/.%

Teraz możemy wykorzystać dodatkowe informacje, aby wykonać drugą iterację wykresu:

wykres1=Plot[{f[x],asymptP,x},{x,-8,8},Exclusions->exclusions,PlotStyle->{{Blue},{Dashed,Thin,Black},{Dotted,Thin,Black}},PlotRange->{-8,8},Epilog->{DotDashed,Line[{{exclusions,-20},{exclusions,20}}]},AspectRatio->1]

Granice na krańcach dziedziny

Kolejnym etapem klasycznej analizy jest obliczenie granic na krańcach dziedziny. Jedynym punktem jest tu 1. Ale musimy jakoś poradzić sobie z nieskończonościami:

If[testD[-Infinity],
Join[
{-Infinity},
If[testD[Infinity],Join[{exclusions},{Infinity}],exclusions]
]
]

Oto punkty w których będziemy liczyć granice:

punkty=Sort[%,#1<#2&]

punkty=Sort[%,Less] (* równoważny #1<#2 & zapis *)

Sort[{-Infinity,1,Infinity}] (* niemiła niespodzianka, ale zgodna z manualem *)

Sort[{-Infinity,1,Infinity},#1<#2&] (* niemiła niespodzianka *)

Aby zapisać ,,treść’’ w postaci ,,nieobliczonej’’, zamiast f[x] użyłem “f”[x]:

TraditionalForm[Limit["f"[x],x->punkty[[2]],Direction->-1]]

Poniższe polecenia mają w zamyśle obliczyć wszystkie granice:

Table[{
ToString@TraditionalForm[Limit["f"[x],x->punkty[[k]],Direction->sign]]<>"="<>ToString[TraditionalForm@
Limit[f[x],x->punkty[[k]],Direction->sign]]},
{sign,{-1,1}},{k,1,Length[punkty]}]//Flatten (* niedopracowane szczegóły: nie ma np: granicy prawostronnej w -Infinity ! *)

Granice powyżej nic nie wnoszą do wykresu, ale są z nim zgodne.

Abs[-Infinity]//FullForm

Miejsca zerowe

Z wykresu widać, że jest jedno miejsce zerowe. Dla pewności sprawdzamy to za pomocą np: FindInstance:

Solve[f[x]==0,x]

FindInstance[f[x]==0,x,Reals,12]

Jedynym miejscem zerowym jest x=-1.

miejscaZerowe=x/.%

Minima i maksima lokalne oraz monotoniczność

Wykres pokazuje, że brak ekstremów (,,górek i dolin’’). Rachunek to potwierdza: pochodna nigdy nie jest równa zeru.

Solve[f'[x]==0,x]

Możemy też zbadać monotoniczność. Poniższy wynik pokazuje, że funkcja nigdzie nie rośnie.

Solve[f'[x]>0,x]

Skoro nigdzie nie rośnie, to zapewne maleje:

Solve[f'[x]<0,x]

Poniższy wynik to cała dziedzina funkcji:

Reduce[f'[x]<0,x]

Asymptoty ukośne

Jak już wiemy z analizy przeciwdziedziny i wykresu, powinna być asymptota y=0 (y =  a x +b, gdzie a=0, b=1 ).

a=Limit[f[x]/x,x->Infinity]

b=Limit[f[x]-a x,x->Infinity]

Punkty przegięcia

Poniższy wynik demonstruje, że funkcja jest bardzo ,,regularna’’, nia ma nawet punktów przegięcia:

Solve[f''[x]==0,x]

Punkty charakterystyczne: zebranie wyników na wykresie

Funkcja jest dosyć ,,nudna’’: jedynymi punktami charakterystycznymi są miejsce zerowe i przecięcie z osią Oy:

{miejscaZerowe,f[miejscaZerowe]}

punktyMiejscaZerowe=Transpose[%]

punktOy={{0,f[0]}}

pkt=ListPlot[Join[punktyMiejscaZerowe,punktOy]]

Wreszcie końcowy rezultat naszych wysiłków:

Show[wykres1,pkt,PlotLabel->("f"[x]==f[x])]

Bardziej skomplikowany przykład

Definicja funkcji f[x]=(x^2+x+1)/x

f[x_]:=(x^2+x+1)/x

f[0]

f[1]

Plot[f[x],{x,-4,4}]

Parzystość, nieparzystość, inne symetrie

f[x]==f[-x]

ForAll[x,f[x]==f[-x]]

Reduce[%,Reals]

Reduce[ForAll[x,f[x]==-f[-x]],Reals]

Reduce[Exists[T,T≠0,ForAll[x,f[x]==f[x+T]]],Reals]

Wyznaczenie dziedziny i przeciwdziedziny

dziedzina=Reduce[Exists[y,y==f[t]],Reals]

testD=Function[t,Evaluate[dziedzina]]

testD[-3]

testD[Infinity]

testD[-Infinity]

przeciwdziedzina=Reduce[Exists[t,y==f[t]],Reals]

osobliwe=Reduce[Not[dziedzina]]

ToRules[osobliwe]

exclusions=t/.%

Not[przeciwdziedzina]

Simplify[%]

y1=%[[1]]

y2=%%[[-1]]

wykres1=Plot[{f[x],y1,y2},{x,-4,4},Exclusions->exclusions,PlotStyle->{{Blue},{Thin,Dotted},{Thin,Dotted}},PlotRange->{-12,12},Epilog->{Dotted,Line[{{exclusions,-20},{exclusions,20}}]}]

Granice na krańcach dziedziny

If[testD[-Infinity],
Join[
{-Infinity},
If[testD[Infinity],Join[{exclusions},{Infinity}],exclusions]
]
]

punkty=Sort[%,#1<#2&]

Table[{
ToString@TraditionalForm[Limit["f"[x],x->punkty[[k]],Direction->sign]]<>"="<>ToString[TraditionalForm@
Limit[f[x],x->punkty[[k]],Direction->sign]]},
{sign,{-1,1}},{k,1,Length[punkty]}]//Flatten (* niedopracowane szczegóły: nie ma np: granicy prawostronnej w -Infinity ! *)

Miejsca zerowe

FindInstance[f[x]==0,x,Reals,12]

Minima i maksima lokalne

Solve[f'[x]==0,x]

ekstrema=x/.%

f[%]

{y1,y2} (* powinno to być zgodne z przeciwdziedziną *)

Asymptoty ukośne

a=Limit[f[x]/x,x->Infinity]

b=Limit[f[x]-a x,x->Infinity]

Punkty przegięcia

Solve[f''[x]==0,x]

Przecięcia z asymptotami i osią Oy

Solve[f[x]==a x +b,x]

Punkty charakterystyczne: zebranie wyników na wykresie

punktOy={{0,f[0]}}

pktEkstr=Transpose[{ekstrema,f[ekstrema]}]

xAsympt=x/.Solve[a x +b ==0,x][[1]] (* przecięcie asymptoty z osią Ox *)

pkt=ListPlot[Join[pktEkstr,{{0,b},{xAsympt,0}}]]

wykres2=Plot[{f[x],a x+ b,y1,y2},{x,-4,4},Exclusions->exclusions,PlotStyle->{{Blue},{Black,Thin,Dashed},{Thin,Dotted},{Thin,Dotted}},PlotRange->{-12,12},Epilog->{Dotted,Line[{{exclusions,-20},{exclusions,20}}]}]

Show[wykres2,pkt]

xTicks=Join[{0,xAsympt},ekstrema]//Sort

yTicks=Join[{0,b},f[ekstrema]]

wykres3=Plot[{f[x],a x+ b,y1,y2},{x,-3,3},Exclusions->exclusions,PlotStyle->{{Blue},{Black,Thin,Dashed},{Thin,Dotted},{Thin,Dotted}},PlotRange->{-8,8},Epilog->{Dotted,Line[{{exclusions,-20},{exclusions,20}}]},Ticks->{xTicks,yTicks}]

Show[wykres3,pkt]

wykres4=Plot[{f[x],a x+ b,y1,y2},{x,-8,8},Exclusions->exclusions,PlotStyle->{{Blue},{Black,Thin,Dashed},{Thin,Dotted},{Thin,Dotted}},PlotRange->{-8,8},Epilog->{Dotted,Line[{{exclusions,-20},{exclusions,20}}]},Ticks->{xTicks,yTicks},AspectRatio->1]

Show[wykres4,pkt]

Jeszcze bardziej skomplikowany przykład

Definicja funkcji f[x]=(x^4-x+1)/(x^3-x+3)

f[x_]:=(x^4-x+1)/(x^3-x+3)

f[x]//Simplify

f[0]

f[1]

Plot[f[x],{x,-4,4}]

Parzystość, nieparzystość, inne symetrie

f[x]==f[-x]

ForAll[x,f[x]==f[-x]]

Reduce[%,Reals]

Reduce[ForAll[x,f[x]==-f[-x]],Reals]

Reduce[Exists[T,T≠0,ForAll[x,f[x]==f[x+T]]],Reals]

Wyznaczenie dziedziny i przeciwdziedziny

dziedzina=Reduce[Exists[y,y==f[t]],Reals] (* inna metoda niż wyżej! *)

testD=Function[t,Evaluate[dziedzina]]

testD[-3]

testD[Infinity]

testD[-Infinity]

przeciwdziedzina=Reduce[Exists[t,y==f[t]],Reals]

osobliwe=Reduce[Not[dziedzina]]

ToRules[osobliwe]

exclusions=t/.%

Reduce[Not[przeciwdziedzina]]

{y1,y2}={%[[1]],%[[-1]]}

N[{y1,y2}]

wykres1=Plot[{f[x],y1,y2},{x,-4,4},Exclusions->exclusions,PlotStyle->{{Blue},{Thin,Dotted},{Thin,Dotted}},PlotRange->{-12,12},Epilog->{Dotted,Line[{{exclusions,-20},{exclusions,20}}]}]

Granice na krańcach dziedziny

If[testD[-Infinity],
Join[
{-Infinity},
If[testD[Infinity],Join[{exclusions},{Infinity}],exclusions]
]
]

punkty=Sort[%,#1<#2&]

Table[{
ToString@TraditionalForm[Limit["f"[x],x->punkty[[k]],Direction->sign]]<>"="<>ToString[TraditionalForm@
Limit[f[x],x->punkty[[k]],Direction->sign]]},
{sign,{-1,1}},{k,1,Length[punkty]}]//Flatten (* niedopracowane szczegóły: nie ma np: granicy prawostronnej w -Infinity ! *)

Miejsca zerowe

FindInstance[f[x]==0,x,Reals,12]

Minima i maksima lokalne

Solve[f'[x]==0,x,Reals]

ekstrema=x/.%

Asymptoty ukośne

a=Limit[f[x]/x,x->Infinity]

b=Limit[f[x]-a x,x->Infinity]

a=Limit[f'[x],x->Infinity]

Punkty przegięcia

Solve[f''[x]==0,x,Reals]

xPrzegiecia=x/.%

Przecięcia z asymptotami i osią Oy

Solve[f[x]==a x +b,x,Reals]

xUkosne=x/.%

Punkty charakterystyczne: zebranie wyników na wykresie

punktOy={{0,f[0]}}

pktEkstr=Transpose[{ekstrema,f[ekstrema]}];

pktPrzeg=Transpose[{xPrzegiecia,f[xPrzegiecia]}]//FullSimplify;

pktUkosne=Transpose[{xUkosne,f[xUkosne]}]//Simplify

pktUkosne//N

pktPrzeg//N

pktE=ListPlot[pktEkstr,PlotStyle->Red]

pktP=ListPlot[pktPrzeg,PlotStyle->Green]

pktI=ListPlot[pktUkosne,PlotStyle->Black]

wykres2=Plot[{f[x],a x+ b,y1,y2},{x,-6,14},Exclusions->exclusions,PlotStyle->{{Blue},{Black,Thin,Dashed},{Thin,Dotted},{Thin,Dotted}},PlotRange->{-12,12},Epilog->{Dotted,Line[{{exclusions,-20},{exclusions,20}}]}]

Show[wykres2,pktE,pktI,pktP]

Plot[{f[x],a x+ b,y1,y2},{x,0.2,0.3},Exclusions->exclusions,PlotStyle->{{Blue},{Black,Thin,Dashed},{Thin,Dotted},{Thin,Dotted}},PlotRange->{0,1/2},Epilog->{Dotted,Line[{{exclusions,-20},{exclusions,20}}]}]

Show[%,pktE,pktI,pktP]

Analiza wielomianu

Definicja funkcji f[x]=x^4+x^3-x-3

Quit[]

f[x_]:=x^4+x^3-x-3

f[x]//Simplify

f[x]//Factor

f[0]

f[1]

Plot[f[x],{x,-2,2}]

Parzystość, nieparzystość, inne symetrie

f[x]==f[-x]

ForAll[x,f[x]==f[-x]]

Reduce[%,Reals]

Reduce[ForAll[x,f[x]==-f[-x]],Reals]

Reduce[Exists[T,ForAll[x,f[x]==f[x+T]]],Reals] (* ?????????!!!!!!!!!!!!!!!!! *)

Reduce[Exists[T,T≠0,ForAll[x,f[x]==f[x+T]]],Reals] (* No tak, dla T=0 powyższe jest prawdą *)

Reduce[ForAll[x,f[x]==f[x+T]],Reals]  (* Inny sposób *)

Wyznaczenie dziedziny i przeciwdziedziny

dziedzina=Reduce[Exists[y,y==f[t]],Reals] (* inna metoda niż wyżej! *)

przeciwdziedzina=Reduce[Exists[t,y==f[t]],Reals]

Reduce[Not[przeciwdziedzina]]

yMIN=%[[2]]

wykres1=Plot[{f[x]},{x,-4,4},PlotStyle->{{Blue}},PlotRange->{yMIN,12}]

Granice na krańcach dziedziny

punkty={-Infinity,Infinity}

Table[
ToString@TraditionalForm[Limit["f"[x],x->punkty[[k]]]]<>"="<>ToString[TraditionalForm@
Limit[f[x],x->punkty[[k]]]],{k,1,Length[punkty]}]

Miejsca zerowe

FindInstance[f[x]==0,x,Reals,12]

miejscaZerowe=x/.%

Minima i maksima lokalne

Solve[f'[x]==0,x,Reals]

ekstrema=x/.%

Punkty przegięcia

Solve[f''[x]==0,x,Reals]

xPrzegiecia=x/.%

Punkty charakterystyczne: zebranie wyników na wykresie

{miejscaZerowe,f[miejscaZerowe]}

punktyMiejscaZerowe=Transpose[%]

punktOy={{0,f[0]}}

pktEkstr=Transpose[{ekstrema,f[ekstrema]}];

pktPrzeg=Transpose[{xPrzegiecia,f[xPrzegiecia]}]//FullSimplify;

pktE=ListPlot[pktEkstr,PlotStyle->Red]

pktP=ListPlot[Join[punktyMiejscaZerowe,pktPrzeg,punktOy],PlotStyle->Black]

wykres2=Plot[f[x],{x,-2,2},PlotStyle->{{Blue},{Black,Thin,Dashed}},PlotRange->{yMIN,12}]

Show[wykres2,pktE,pktP]

Funkcja gaussopodobna

Definicja funkcji f[x]=x^2 Exp[-x^2]

f[x_]:=x^2 Exp[-x^2]

(* f[x_]:=Sin[x] *)

f[x]//Simplify

f[0]

f[1]

Plot[f[x],{x,-2,2}]

Parzystość, nieparzystość, inne symetrie

f[x]==f[-x]

ForAll[x,f[x]==f[-x]]

Reduce[%,Reals]

Reduce[ForAll[x,f[x]==-f[-x]],Reals]

Reduce[ForAll[x,f[x]==f[x+T]],Reals]

Wyznaczenie dziedziny i przeciwdziedziny

dziedzina=Reduce[Exists[y,y==f[t]],Reals] (* inna metoda niż wyżej! *)

Reduce[Exists[t,y==f[t]],Reals]

przeciwdziedzina=Simplify[%]

yMIN=przeciwdziedzina[[1]]

yMAX=przeciwdziedzina[[-1]]

wykres1=Plot[{f[x]},{x,-4,4},PlotStyle->{{Blue}},PlotRange->{yMIN,yMAX}]

Granice na krańcach dziedziny

Miejsca zerowe

FindInstance[f[x]==0,x,Reals,12]

miejscaZerowe=x/.%

Minima i maksima lokalne

Solve[f'[x]==0,x,Reals]

ekstrema=x/.%

Asymptoty ukośne

a=Limit[f[x]/x,x->Infinity]

b=Limit[f[x]-a x,x->Infinity]

a=Limit[f'[x],x->Infinity]

Punkty przegięcia

Solve[f''[x]==0,x,Reals]

xPrzegiecia=x/.%

Przecięcia z asymptotami i osią Oy

Solve[f[x]==a x +b,x,Reals]

xUkosne=x/.%

Punkty charakterystyczne: zebranie wyników na wykresie

{miejscaZerowe,f[miejscaZerowe]}

punktyMiejscaZerowe=Transpose[%]

punktOy={{0,f[0]}}

pktEkstr=Transpose[{ekstrema,f[ekstrema]}];

pktPrzeg=Transpose[{xPrzegiecia,f[xPrzegiecia]}]//FullSimplify;

pktUkosne=Transpose[{xUkosne,f[xUkosne]}]//Simplify

pkt=Join[punktyMiejscaZerowe, punktOy, pktEkstr,pktPrzeg, pktUkosne] //DeleteDuplicates

pktWykres=ListPlot[pkt]

wykres2=Plot[f[x],{x,-3,3},PlotStyle->{{Blue},{Black,Thin,Dashed}},PlotRange->{yMIN,yMAX}]

Show[wykres2,pktWykres]

xTicks=Transpose[pkt][[1]]//Sort//ToRadicals

yTicks=Transpose[pkt][[2]]//Sort//DeleteDuplicates

wykres3=Plot[{f[x],a x+ b},{x,-3,3},PlotStyle->{{Blue},{Black,Thin,Dashed}},PlotRange->{yMIN,yMAX},Ticks->{xTicks,yTicks}]

Show[wykres3,pktWykres]

Transformacje wykresów funkcji

(* Wybierz JEDNĄ z ponizszych funkcji lub zdefiniuj samodzielnie. Polecenia wykonujemy naciskając Shift+Enter. 
Linia przerywana pokazuje wykres funkcji oryginalnej, ciągła linia to wykres funkcji przetransformowanej

UWAGA; 
1. Niektóre wykresy mogą mieć po transformacji zmienioną dziedzinę.;
2. Wykres funkcja odwrotnej pokazuje tylko jedno mozliwe rozwiązanie
*)

Quit[]

f[x_]:=Sign[x]x^2/4-1

f[x_]:=-2x-1

f[x_]:=2Sin[Pi x/2]

f[x_]:=Exp[x]

f[x_]:=x(x^2+x-1)

f[x_]:=(x+1)/(x-1)

f[x_]:=Tan[x]

f[x_]:=Sqrt[x]

f[x_]:=Log[x]/Log[2]

f[x_]:=Abs[x]^x

f[x_]:=Abs[x-1]-1

f[x_]:=Log[Cos[ x Pi]+1]/Log[2]

f[x_]:=x^(5/3)

f[x_]:=Sign[x]Abs[x]^(1/3)

f[x_]:=x +Sign[x]

f[x_]:=FractionalPart[x]

f[x_]:=1/Sin[Pi x]

f[x_]:=Piecewise[{{x/2,x<=0},{2x,x>0}}]

f[x_]:= Log[1+x^4/((1/26) (3+(Sqrt[61])))]/Log[1+(26/(3+(Sqrt[61])))]

f[x_]:=-1/2(2-x)^2+3

f[x_]:=Log[2,x+1]

odp=True

wzor=True

label=ToString[f[x]//TraditionalForm]

dziedzina=Reduce[Evaluate[f[t]]∈Reals,t,Reals]

dziedzina=Reduce[Exists[y,y==f[t]],Reals] (* inna metoda niż wyżej! *)

przeciwdziedzina=Reduce[Exists[t,y==f[t]],Reals]

p0=Plot[f[t],{t,-4,4},PlotStyle->{Black},AspectRatio->1,PlotRange->{{-4,4},{-4,4}},Ticks->{{-4,-3,-2,-1,0,1,2,3,4},{-4,-3,-2,-1,0,1,2,3,4}},GridLines->{{-4,-3,-2,-1,0,1,2,3,4},{-4,-3,-2,-1,0,1,2,3,4}},
PlotLabel->If[wzor,label<>"\n","f(x)"]]

SetOptions[Plot,PlotStyle->{{DotDashed,Black},{RGBColor[1,0,0,0.7],Thick},{Black,Dotted}},Epilog->{Arrow[{{-4,0},{4,0}}],Arrow[{{0,-4},{0,4}}]},ImageSize->300
];

Manipulate[
Plot[Evaluate@If[odp,{f[t],If[dziedzina,λ(Abs[f[t]]-f[t])+f[t]]},f[t]],{t,-4,4},AspectRatio->1,PlotRange->{{-4,4},{-4,4}},Ticks->{{-4,-3,-2,-1,0,1,2,3,4},{-4,-3,-2,-1,0,1,2,3,4}},GridLines->{{-4,-3,-2,-1,0,1,2,3,4},{-4,-3,-2,-1,0,1,2,3,4}},PlotLabel->If[odp,"|f(x)| \n (odbicie lustrzane czesci ujemnej)","|f(x)|"]],
{{λ,1},0,1}
]

Manipulate[
Plot[Evaluate@If[odp,{f[t],f[-t/λ]},f[t]],{t,-4,4},AspectRatio->1,PlotRange->{{-4,4},{-4,4}},Ticks->{{-4,-3,-2,-1,0,1,2,3,4},{-4,-3,-2,-1,0,1,2,3,4}},GridLines->{{-4,-3,-2,-1,0,1,2,3,4},{-4,-3,-2,-1,0,1,2,3,4}},PlotLabel->If[odp,"f(-x) \n (odbicie lustrzane wzgledem osi pionowej Oy)","f(-x)"]],
{{λ,1},-1,1}]

Manipulate[
Plot[Evaluate@If[odp,{f[t],-λ f[t]},f[t]],{t,-4,4},AspectRatio->1,PlotRange->{{-4,4},{-4,4}},Ticks->{{-4,-3,-2,-1,0,1,2,3,4},{-4,-3,-2,-1,0,1,2,3,4}},GridLines->{{-4,-3,-2,-1,0,1,2,3,4},{-4,-3,-2,-1,0,1,2,3,4}},PlotLabel->If[odp,"-f(x) \n (odbicie wzgledem osi poziomej Ox)","-f(x)"]],
{{λ,1},-1,1}
]

Manipulate[
Plot[Evaluate@If[odp,{f[t],-λ f[-t/λ]},f[t]],{t,-4,4},AspectRatio->1,PlotRange->{{-4,4},{-4,4}},Ticks->{{-4,-3,-2,-1,0,1,2,3,4},{-4,-3,-2,-1,0,1,2,3,4}},GridLines->{{-4,-3,-2,-1,0,1,2,3,4},{-4,-3,-2,-1,0,1,2,3,4}},PlotLabel->If[odp,"-f(-x) \n (symetria srodkowa wzgledem poczatku ukladu)","-f(-x)"]],
{{λ,1},-1,1}]

Manipulate[
Plot[Evaluate@If[odp,{f[t],f[t]-a},f[t]],{t,-4,4},AspectRatio->1,PlotRange->{{-4,4},{-4,4}},Ticks->{{-4,-3,-2,-1,0,1,2,3,4},{-4,-3,-2,-1,0,1,2,3,4}},GridLines->{{-4,-3,-2,-1,0,1,2,3,4},{-4,-3,-2,-1,0,1,2,3,4}},PlotLabel->"f(x)-a"],
{{a,1},-4,4,0.1}
]

Manipulate[
Plot[Evaluate@If[odp,{f[t],f[t+a]},f[t]],{t,-4,4},AspectRatio->1,PlotRange->{{-4,4},{-4,4}},Ticks->{{-4,-3,-2,-1,0,1,2,3,4},{-4,-3,-2,-1,0,1,2,3,4}},GridLines->{{-4,-3,-2,-1,0,1,2,3,4},{-4,-3,-2,-1,0,1,2,3,4}},PlotLabel->"f(x+a) "],
{{a,1},-4,4,0.1}]

Manipulate[
Plot[Evaluate@If[odp,{f[t],f[λ t]},f[t]],{t,-4,4},AspectRatio->1,PlotRange->{{-4,4},{-4,4}},Ticks->{{-4,-3,-2,-1,0,1,2,3,4},{-4,-3,-2,-1,0,1,2,3,4}},GridLines->{{-4,-3,-2,-1,0,1,2,3,4},{-4,-3,-2,-1,0,1,2,3,4}},PlotLabel->If[odp,"f(λ x) \n (,,scisniecie/rozciągnięcie'' wykresu w poziomie)","f(2x)"]],
{{λ,2},0.1,10}]

Manipulate[
Plot[Evaluate@If[odp,{f[t],a f[t]},f[t]],{t,-4,4},AspectRatio->1,PlotRange->{{-4,4},{-4,4}},Ticks->{{-4,-3,-2,-1,0,1,2,3,4},{-4,-3,-2,-1,0,1,2,3,4}},GridLines->{{-4,-3,-2,-1,0,1,2,3,4},{-4,-3,-2,-1,0,1,2,3,4}},PlotLabel->If[odp,"a f(x) \n (rozciagniecie wykresu w pionie)","2 f(x)"]],
{{a,2},0.1,10}]

Plot[Evaluate@If[odp,{f[t],f[1/t]},f[t]],{t,-4,4},AspectRatio->1,PlotRange->{{-4,4},{-4,4}},Ticks->{{-4,-3,-2,-1,0,1,2,3,4},{-4,-3,-2,-1,0,1,2,3,4}},GridLines->{{-4,-3,-2,-1,0,1,2,3,4},{-4,-3,-2,-1,0,1,2,3,4}},PlotLabel->If[odp,"f(1/x) \n (wykres dla 0<x<1 przechodzi w przedzial 1<x<∞ i vice versa)","f(1/x)"],Exclusions->{0}]

Plot[Evaluate@If[odp,{f[t],1/f[t]},f[t]],{t,-4,4},AspectRatio->1,PlotRange->{{-4,4},{-4,4}},Ticks->{{-4,-3,-2,-1,0,1,2,3,4},{-4,-3,-2,-1,0,1,2,3,4}},GridLines->{{-4,-3,-2,-1,0,1,2,3,4},{-4,-3,-2,-1,0,1,2,3,4}},PlotLabel->If[odp,"1/f(x) \n (wykres dla 0<y<1 przechodzi w przedzial 1<y<∞ i vice versa)","1/f(x)"],Exclusions->(x/.Solve[f[x]==0,x]//Flatten)]

fINV=Function[{x},Evaluate[y/.Solve[f[y]==x,y][[1]]]]

fINV[3/2]

fINV=InverseFunction[f]

fINV[3/2]

Plot[Evaluate@If[odp,{f[t],fINV[t],t},f[t]],{t,-4,4},AspectRatio->1,PlotRange->{{-4,4},{-4,4}},Ticks->{{-4,-3,-2,-1,0,1,2,3,4},{-4,-3,-2,-1,0,1,2,3,4}},GridLines->{{-4,-3,-2,-1,0,1,2,3,4},{-4,-3,-2,-1,0,1,2,3,4}},PlotLabel->If[odp,"(f^(-1))(x) \n (funkcja odwrotna, wykres odbity wzgledem prostej y=x)","(f^(-1))(x)"]]

Analiza przebiegu funkcji wielu zmiennych: wielomiany

w=1-y+2 x y+2 (y^2)+2 (x^2) (y^2)

w=Sum[RandomInteger[{-2,2}]x^n y^m,{n,0,2},{m,0,2}]

w=2+2 x y+2 (x^2) y+(y^2)+x (y^2)+(x^2) (y^2)

(* w= 1+ x y+x^2 y+y^2+x y^2 *)

sol=Solve[{D[w,x]==0,D[w,y]==0},{x,y},Reals]//Simplify

jac={{D[w,x,x],D[w,x,y]},{D[w,y,x],D[w,y,y]}}

Det[jac]//Simplify

jac/.sol

Simplify[Det[jac]/.sol]

N[%]

w/.sol

D[w,x]

D[w,y]

D[w,x,x]

D[w,y,y]

D[w,x,y]

D[w,y,x]

pts=({x,y}/.sol//N)

xMAX=Max@Transpose[pts][[1]]+1/6

xMIN=Min@Transpose[pts][[1]]

rangeX=Join[{x},{4/3 xMIN,4/3xMAX}]

yMAX=Max@Transpose[pts][[2]]

yMIN=Min@Transpose[pts][[2]]

rangeY=Join[{y},{4/3 yMIN-1/6,4/3 yMAX}]

extr=ListPlot[pts,PlotStyle->{PointSize[Large],Red}]

Show[ContourPlot[w,Evaluate@rangeX,Evaluate@rangeY,Contours->144, PlotPoints->64],extr]

pts3d=({x,y,w}/.sol//N)

zMAX=Max[w/.sol]

zMIN=Min[w/.sol]

ptsW=ListPointPlot3D[pts3d,PlotStyle->{{Red,PointSize[Large]}}]

Show[Plot3D[w,Evaluate@rangeX,Evaluate@rangeY,MeshFunctions->{#3&},Mesh->15,PlotPoints->2*64,PlotRange->{zMIN-0.1,zMAX+0.1}],ptsW,RotationAction->Clip]

And[Or[A,B],Or[C,D]]//LogicalExpand

Or[And[A,B],And[C,D]]//LogicalExpand

Funkcje uwikłane