SetOptions[EvaluationNotebook[],CellContext->Notebook]

Ekstrema globalne

Manipulate[Module[{f=(#1#2(1-#1)(2-#2)+2&)},Show[Plot3D[f[x,y],{x,-10,10},{y,-10,10},RegionFunction->If[ww,Function[{x,y,z},x^2+y^2≤(d^2)],Function[{x,y,z},True]],ColorFunction->Function[{x,y,z},Directive[Opacity[0.8],Blue]],Mesh->False],ParametricPlot3D[d{Cos[t],Sin[t],0},{t,0,2Pi},ColorFunction->Function[{x,y,z,u,v},Green]],If[tt,Graphics3D[{Red,PointSize[0.02],Point[{x,y,f[x,y]}/.NSolve[D[f[x,y],{{x,y}}]==0&&x^2+y^2≤d^2,{x,y}]]}],Graphics3D[{}]],Graphics3D[Point[{0,0,0}]],If[mm,Graphics3D[Line[{{d Cos[t],d Sin[t],0},{d Cos[t],d Sin[t],f[d Cos[t],d Sin[t]]}}]],Graphics3D[{}]],If[ss,Graphics3D[{Red,PointSize[0.02],Point[{x,y,0}/.NSolve[D[f[x,y],{{x,y}}]==0&&x^2+y^2≤d^2,{x,y}]]}],Graphics3D[{}]],AxesLabel->{"x","y","z"},Ticks->None,PlotRange->{{-5,5},{-5,5},{-k,h}}]],{{d,1,"radius"},0.1,4,Appearance->"Labeled"},{{h,3,"height"},1,5},{{k,3,"depth"},1,5},{{ww,True,"restrict"},{True,False}},{{t,0,"t"},0,2Pi},{{tt,False,"show critical values"},{True,False}},{{ss,True,"show critical points"},{True,False}},{{mm,False,"points on boundary"},{True,False}},SynchronousUpdating->False]

f[x_,y_]:=x y (1-x)(2-y)+2

reg=Solve[D[f[x,y],{{x,y}}]==0&&x^2+y^2≤1,{x,y}]

f[x,y]/.reg

g[t_]:=f[ Cos[t],Sin[t]]

g[t]

Plot[g[t],{t,0,2Pi}]

t/.Solve[D[g[t],t]==0&&0≤t≤2Pi,t]//N

g[t]/.Solve[D[g[t],t]==0&&0≤t≤2Pi,t]//N

Zbiór nie zwarty

Manipulate[{h=(#1#2 Exp[-(#1^2+#2^2)]&)},Show[Plot3D[h[x,y],{x,-10,10},{y,-10,10},RegionFunction->If[ww,Function[{x,y,z},-d≤x≤d&&-d≤y≤d],Function[{x,y,z},True]],ColorFunction->Function[{x,y,z},Directive[Opacity[0.3],Blue]],Mesh->False],Graphics3D[{Red,Line[{{-d,-d,0},{-d,d,0},{d,d,0},{d,-d,0},{-d,-d,0}}]}],If[tt,Graphics3D[{Red,PointSize[0.02],Point[{x,y,h[x,y]}/.Solve[D[h[x,y],{{x,y}}]==0,{x,y}]]}],Graphics3D[{}]],If[ss,Graphics3D[{Red,PointSize[0.02],Point[{x,y,0}/.Solve[D[h[x,y],{{x,y}}]==0,{x,y}]]}],Graphics3D[{}]],AxesLabel->{"x","y","z"},Ticks->None,PlotRange->{{-5,5},{-5,5},{-1,h}}],{{d,1,"side"},0.1,4,Appearance->"Labeled"},{{h,3,"height"},3,8},{{ww,False,"ogranicz"},{True,False}},{{tt,False,"wartości krytyczne"},{True,False}},{{ss,False,"punkty krytyczne"},{True,False}},,SynchronousUpdating->False,SaveDefinitions->True]

Manipulate[Quiet[Module[{h=(#1#2 Exp[-(#1^2+#2^2)]&)},Show[Plot3D[h[x,y],{x,-4,4},{y,-4,4},PlotRange->All,PlotPoints->50,RegionFunction->If[ww,Function[{x,y,z},-d≤x≤d&&-d≤y≤d],Function[{x,y,z},True]],ColorFunction->Function[{x,y,z},Directive[Opacity[0.6],Blue]]],Graphics3D[{Red,Line[{{-d,-d,0},{-d,d,0},{d,d,0},{d,-d,0},{-d,-d,0}}]}],If[tt,Graphics3D[{Red,PointSize[0.02],Point[{x,y,h[x,y]}/.Solve[D[h[x,y],{{x,y}}]==0,{x,y}]]}],Graphics3D[{}]],AxesLabel->{"x","y","z"},Ticks->None]]],{{d,3,"side"},0.1,4,Appearance->"Labeled"},{{ww,False,"ogranicz"},{True,False}},{{tt,False,"wartości krytyczne"},{True,False}},SynchronousUpdating->False,SaveDefinitions->True]

h[x_,y_]:= x y Exp[-(x^2+y^2)]

reg=Solve[D[h[x,y],{{x,y}}]==0,{x,y},Method->Reduce]

h[x,y]/.reg

Ekstrema lokalne

Clear[f,g,h]

f[x+h]=f[x]+h f'[x] + ((h^2)/(2!))f''[x] + r[h] (h^2)

f[x+(Subscript[h, 1]),y+(Subscript[h, 2])] = f[x,y]+ …

Collect[Normal[f[x+t (Subscript[h, 1]),y+t (Subscript[h, 2])] +((O[t])^3)],t]

%/.t->1

f(x,y)+(Subscript[h, 2]) Derivative[0,1][f](x,y)+(Subscript[h, 1]) Derivative[1,0][f](x,y)+(1/2) ((Subscript[h, 1]^2) Derivative[2,0][f](x,y)+2 (Subscript[h, 2]) (Subscript[h, 1]) Derivative[1,1][f](x,y)+(Subscript[h, 2]^2) Derivative[0,2][f](x,y))

D[f[x,y],{{x,y},2}]

β[f_][x_,y_][h_,k_]:=f(x,y)+k Derivative[0,1][f](x,y)+h  Derivative[1,0][f](x,y)+(1/2) ((h^2) Derivative[2,0][f](x,y)+2 k h Derivative[1,1][f](x,y)+(k^2) Derivative[0,2][f](x,y))

β[g][x,y][h,k]

{(Subscript[h, 1]),(Subscript[h, 2])}.(({{Derivative[2,0][f](x,y), Derivative[1,1][f](x,y)}, {Derivative[1,1][f](x,y), Derivative[0,2][f](x,y)}})).{(Subscript[h, 1]),(Subscript[h, 2])}//Expand

(({{Derivative[2,0][f](x,y), Derivative[1,1][f](x,y)}, {Derivative[1,1][f](x,y), Derivative[0,2][f](x,y)}}))

f((OverVector[h])+(OverVector[x]))=f((OverVector[x]))+Df((OverVector[x]))((OverVector[h]))+(1/2) (D^2) f(x)((OverVector[h]),(OverVector[h]))+((Norm[(OverVector[h])])^2) r((OverVector[h]))

Zakładamy że

Df((OverVector[x]))((OverVector[h])) == (OverVector[0])

f((OverVector[h])+(OverVector[x]))=f((OverVector[x]))+(1/2) (D^2) f(x)((OverVector[h]),(OverVector[h]))+((Norm[(OverVector[h])])^2) r((OverVector[h]))

Z tego wynika że jeśli  (1/2) (D^2) f(x)((OverVector[h]),(OverVector[h]))  jest niezerowa dla wszystkich niezerowych wektorów (OverVector[h]) to resztę można zignorować. Jeśli forma jest zawsze dodatnia (dodatnio określona) to mamy lokalne minimum, jeśli ujemnie orkeślona to mamy lokalne maksimum, a jeśli nie-określona to nie mamy ani lokalnego maksimum ani minimum.

Metoda nie działa kiedy mamy conajmniej jedną zerową wartość charakterystyczną a wszyskie nie zerowe mają ten sam znak.

f[x_,y_]:=x y (1-x)(2-y)+2

rules=Solve[D[f[x,y],{{x,y}}]==0,{x,y}]

MatrixForm/@(D[f[x,y],{{x,y},2}]/.rules)

Eigenvalues/@(D[f[x,y],{{x,y},2}]/.rules)

PositiveDefiniteMatrixQ/@(D[f[x,y],{{x,y},2}]/.rules)

NegativeDefiniteMatrixQ/@(D[f[x,y],{{x,y},2}]/.rules)

Eigenvalues[{{0,2},{2,0}}]

β[f][1/2,1][h,k]

Show[Plot3D[f[h,k],{h,-4,4},{k,-4,4},ColorFunction->Function[{x,y,z},{Opacity[0.5],Red}],Mesh->False],Plot3D[β[f][1/2,1][h,k],{h,-4,4},{k,-4,4},ColorFunction->Function[{x,y,z},{Opacity[0.5],Blue}],Mesh->False],Graphics3D[{PointSize[0.02],Yellow,Point[{1/2,1,f[1/2,1]}]}]]

f[x_,y_]:=Exp[-(((x+y))^2)]

D[f[x,y],{{x,y},1}]==0

Reduce[D[f[x,y],{{x,y},1}]==0,{x,y}]

M=D[f[x,y],{{x,y},2}]/.y->-x

IndefiniteMatrixQ[M]

PositiveDefiniteMatrixQ[M]

Eigenvalues[M]

Plot3D[f[x,y],{x,-1,1},{y,-1,1}]

Macierz Jacobiego

f[x_,y_]:={x,x+y,x y}

D[f[x,y],{{x,y}}]

D[f[x,y],{{x,y}}]/.{x->1,y->7}

(({{1, 0}, {1, 1}, {7, 1}})).{h,k}

(({{1, 0}, {1, 1}, {7, 1}})).(({{h}, {k}}))

Clear[f]

a)

f[x_,y_,z_,w_]:=Exp[x y z w];

a={1,0,1,0};

v={0,(1/(Sqrt[2])),0,(1/(Sqrt[2]))};

Limit[(f@@(a+t v)-f@@a)/t,t->0]

b)

(D[f[x,y,z,w],{{x,y,z,w}}]/.Thread[{x,y,z,w}->a]).v

(D[f[x,y,z,w],{{x,y,z,w}}]/.Thread[{x,y,z,w}->a])

Reguła Łańcuchowa

Twierdzenie

U⊂(ℝ^m) otwarty podzbiór, x∈U, V⊂(ℝ^p), otwarty podzbiór, y∈ V, f:U-> V funkcja taka że f(x)=y, oraz g:V-> (ℝ^q). Jeśli f jest różniczkowalna w x z różniczką α i g różniczkowalna w y z różniczką β, to g∘f różniczkowalna w x z różniczką β α.

D(g∘f)(x)==Dg  (f (x)) Df (x)

Dla porównania dla funkcji jednej zmiennej:

((g@*f))'(x)== g'(f(x))f'(x)

Uwaga

W przypadku funkcji jednej zmiennej zamiast macierzy Jakobiego mamy wektor zwany gradientym.  Dla przykładu, rozważmy złożenie dwóch funkcji

f[x_]:={(Subscript[f, 1])[x],(Subscript[f, 2])[x]}

i

g[{x_,y_}]:={(Subscript[g, 1])[x,y],(Subscript[g, 2])[x,y]}

Composition[g,f][x]

D[f[x],x]

wektor

D[f[x],{{x}}]

D[g[{x,y}],{{x,y}}]

(D[g[{x,y}],{{x,y}}]/.{x->(Subscript[f, 1])[x],y->(Subscript[f, 2[x]])}).D[f[x],x]

(D[g[{x,y}],{{x,y}}]/.{x->(Subscript[f, 1])[x],y->(Subscript[f, 2[x]])}).D[f[x],{{x}}]

D[Composition[g,f][x],x]

D[Composition[g,f][x],{{x}}]

a)

Chcemy udowodnić

((∂(f(x) g(x)))/(∂x))== g(x) f'(x)+f(x) g'(x)

Przedstawiamy  funkcję

x->g(x) h(x)

jako złożenie funkcji  ℝ -> (ℝ^2)

t-> {g[t],h[t]}

i funkcji (ℝ^2)-> ℝ

{x,y}->x y

Obliczamy macierze Jacobiego

D[{x y},{{x,y}}]

D[x y,{{x,y}}]

D[{g[t],h[t]},{{t}}]

{{y,x}}.(({{g'(t)}, {h'(t)}}))/.{x->g[t],y->h[t]}

{{y,x}}.{g'[t],h'[t]}/.{x->g[t],y->h[t]}

{x,y}->(x^y)

{{g'[t]},{h'[t]}}

D[(x^y),{{x,y}}]/.{x->g[t],y->h[t]}

{h(t) ((g(t))^(h(t)-1)),((g(t))^(h(t))) log(g(t))}.{{g'[t]},{h'[t]}}

Clear[f]

sphere[θ_,ϕ_]:={Cos[θ]Cos[ϕ],Cos[ϕ]Sin[θ],Sin[ϕ]}

f[x_,y_,z_]:= (x^2)+(y^2)+(z^2)-1

graph1=ParametricPlot3D[{Cos[θ]Cos[ϕ],Cos[ϕ]Sin[θ],Sin[ϕ]},{θ,0,2Pi},{ϕ,0,2Pi},Axes->False];

D[f[x,y,z],{{x,y,z}}]/.Thread[{x,y,z}->sphere[θ,ϕ]]

Manipulate[Show[{ParametricPlot3D[{Cos[θ]Cos[ϕ],Cos[ϕ]Sin[θ],Sin[ϕ]},{θ,0,2Pi},{ϕ,0,2Pi},Axes->False],If[w,ParametricPlot3D[{Cos[θ]Cos[θ],Cos[θ]Sin[θ],Sin[θ]},{θ,0,2Pi},Axes->False,ColorFunction->Function[{x},Blue]],Graphics3D[{}]],Graphics3D[{Red,Arrow[{{Cos[θ]Cos[ϕ],Cos[ϕ]Sin[θ],Sin[ϕ]},{Cos[θ]Cos[ϕ],Cos[ϕ]Sin[θ],Sin[ϕ]}+Normalize[{2 Cos[θ] Cos[ϕ],2 Sin[θ] Cos[ϕ],2Sin[ϕ]}]}]}],Graphics3D[If[w,Arrow[{{Cos[u]Cos[u],Cos[u]Sin[u],Sin[u]},{Cos[u]Cos[u],Cos[u]Sin[u],Sin[u]}+Normalize[D[{Cos[u]Cos[u],Cos[u]Sin[u],Sin[u]},u]]}]/.u->s,{}]]},PlotRange->2],{{θ,0,"θ"},0,2Pi},{{ϕ,0,"ϕ"},0,2Pi},{{s,0,"s"},0,2Pi},{{w,False,"pokaż ścieżkę"},{True,False}},SaveDefinitions->True]

Niech A= (f^(-1))({f((Subscript[x, 0]))}). 
Rozważmy krzywą różniczkowalną

γ:[a,b]⟶ A

taką że f((Subscript[t, 0]))= (Subscript[x, 0]).  Niech g: [a,b]->ℝ będzie funkcją

g(t)=f(γ(t))

g jest funkcją stałą, więc g'((Subscript[t, 0]))==0.

Mamy

MJγ((Subscript[t, 0]))==(({{γ'((Subscript[t, 0]))}}))

MJf((Subscript[x, 0]))==grad f((Subscript[x, 0]))

0=grad f[(Subscript[x, 0])].γ'(t)

Clear[f]

t->{t,(c-t)/2}

D[{t,(c-t)/2},{t}]

D[f[x,y],{{x,y}}].{1,-1/2}

Let

V:ℝ\[Cross](ℝ^k)-> (ℝ^k)

V(x,(Subscript[y, 1]),(Subscript[y, 2]),…,(Subscript[y, k]))=(({{x (Subscript[y, 1])}, {x (Subscript[y, 2])}, {…}, {x (Subscript[y, k])}}))

F:D-> ℝ\[Cross](ℝ^k)

F(d)=(({{f(d)}, {(Subscript[g, 1])(d)}, {…}, {(Subscript[g, k])(d)}}))

V∘F

The Jacobian of F is

(({{f'(a)}, {(Subscript[g, 1])'(a)}, {…}, {(Subscript[g, k])'(a)}}))

The Jacobian of V is:

(({{(Subscript[y, 1]), x, 0, 0, ⋯, 0}, {(Subscript[y, 2]), 0, x, 0, …, 0}, {(Subscript[y, n]), 0, 0, 0, …, x}}))

The Jacobian of

V∘F

(({{(Subscript[g(a), 1]), f(a), 0, 0, ⋯, 0}, {(Subscript[g(a), 2]), 0, f(a), 0, …, 0}, {(Subscript[g(a), n]), 0, 0, 0, …, f(a)}}))(({{f'(a)}, {(Subscript[g, 1])'(a)}, {…}, {(Subscript[g, k])'(a)}}))=(({{f'(a)(Subscript[g(a), 1])+f(a) (Subscript[g, 1])'(a)}, {f'(a)(Subscript[g(a), 2]) +f(a )(Subscript[g, 2])'(a)}, {f'(a) (Subscript[g(a), n])+f(a ) (Subscript[g, n])'(a)}})) =f(a). g'(a) + f'(a).g(a)

Płaszczyzna styczna

Jako przykłąd bierzemy funkcję dwóch zmiennych

ff[x_,y_]:= Sqrt[4-x^2-y^2]

g11=Plot3D[ff[x,y],{x,-2,2},{y,-2,2},PlotRange->All,Mesh->False,AxesLabel->{"x","y","z"},ColorFunction->Function[{x,y,z},{Opacity[0.5],Red}]]

styczna1[a_,b_]=(D[ff[x,y],{{x,y}}]/.{x->a,y->b}).{x-a,y-b}+ff[a,b];

styczna1[{a_,b_}]:=styczna1[a,b]

styczna1[a,b]

Manipulate[Show[g11,Plot3D[styczna1[p],{x,-8,8},{y,-8,8},Mesh->False,ColorFunction->Function[{x,y,z},{Opacity[0.5],Blue}]],Graphics3D[{PointSize[0.015],Point[{p[[1]],p[[2]],ff@@p}]}],PlotRange->{{-4,4},{-4,4},{-2,5}}],{{p,{0.5,0.5}},{-1,-1},{1,1},Slider2D},SaveDefinitions->True]

Teraz obliczymy pochodną kierunkową w kierunku wektora (u,v).

Użyjemy do tego celu wielomianu Taylora. Rozważamy funkcją

F[x+tu,y+tv]

jako funkcję jednej zmiennej t. Możemy napisać

F[x + t u, y + t v]+O[t]^2

W naszym przypadku

(Normal[ff[x + t u, y + t v]+O[t]^2]/.{x->a,y->b})

D[(Sqrt[4-(a^2)-(b^2)])+((t (-a u-b v))/(Sqrt[4-(a^2)-(b^2)])),t]/.t->0

(D[ff[x,y],{{x,y}}]/.{x->a,y->b}).{u,v}

Manipulate[Show[g11,Plot3D[styczna1[p],{x,-8,8},{y,-8,8},Mesh->False,ColorFunction->Function[{x,y,z},{Opacity[0.5],Blue}]],Graphics3D[{PointSize[0.015],Point[{p[[1]],p[[2]],ff@@p}]}],ParametricPlot3D[Evaluate[{p[[1]]+t Cos[th],p[[2]]+t Sin[th],Normal[ff[p[[1]]+t  Cos[th],p[[2]]+t Sin[th]]+O[t]^2]}],{t,0,1}],PlotRange->{{-4,4},{-4,4},{-2,5}}],{{p,{0.5,0.5}},{-1,-1},{1,1},Slider2D},{{th,0,θ},0,2Pi},SaveDefinitions->True]

f[x_,y_]:= x y^2 Sin[x^2 +y^2]

(Normal[f[1+t u,2+t v]+O[t]^2]-f[1,2])/t

Normal[f[1+t u,2+t v]+O[t]^2]

g1=Plot3D[f[x,y],{x,-3,3},{y,-3,3},PlotRange->All,Mesh->False,ColorFunction->Function[{x,y,z},{Opacity[0.5],Red}]]

f[1,2]//N

D[f[x,y],{{x,y}}]/.{x->1,y->2}

g[x_,y_]=(D[f[x,y],{{x,y}}]/.{x->1,y->2}).{x-1,y-2}+f[1,2]

g2=Plot3D[g[x,y],{x,-3,3},{y,-3,3},Mesh->False,ColorFunction->Function[{x,y,z},{Opacity[0.5],Blue}]];

Show[g1,g2,Graphics3D[Point[{1,2,f[1,2]}]]]

styczna[a_,b_]=(D[f[x,y],{{x,y}}]/.{x->a,y->b}).{x-a,y-b}+f[a,b]

styczna[{a_,b_}]:=styczna[a,b]

Manipulate[Show[g1,Plot3D[styczna[p],{x,-3,3},{y,-3,3},Mesh->False,ColorFunction->Function[{x,y,z},{Opacity[0.5],Blue}]],Graphics3D[Point[{p[[1]],p[[2]],f@@p}]]],{{p,{1,1}},{-3,-3},{3,3},Slider2D},SaveDefinitions->True]