Határidő: február 21. (hétfő) 18 óra

Ide: jtoth@math.bme.hu 
Subject: Szg 
Állománynév: AzEnNevem01.nb
Mindig használjunk néhány opciót.

1. Ismertessünk néhány mondatban a NestList függvényre vonatkozó alkalmazást innen.

Ábécérendben.

Darvalics Bianka

Ha értem a feladatot, akkor a NestList egy alkalmazását kell pár mondatban kifejteni. Számomra (közgazdasági alkalmazása miatt) a logisztikus egyenlet ábrázolása volt érdekes. A logisztikus egyenlet ugyanis egy rekurzív egyenlet, melyet a NestList függvénnyel könnyen implementálhatjuk, és a Manipulate függvénnyel ezt különböző paraméterekre ábrázolhatjuk. A logisztikus egyenlet egy differencia egyenlet, amelynek egy a paramétertől függ a fixpontjának stabilitása. A függvénynek 2 fixpontja van, a triviális x_ 0 = 0 ami instabil és az x_ 0 = 1 - 1/a, ez viszont a paraméter függvényében nagyban változó. Ha ugyanis 1<a<3 az egyenletnek globálisan stabil fixpontja van, ha 3<a<3,57 intervallumba esik (2^k)db (2^h)-ciklusa van (h=1,2,...,k-1) és egy instabil fixpontja van, végül, ha 3,57<a<=4 esetnén pedig kaotiksan viselkedik. Ezt hivatott ez az alkalmazás is megmutatni.

Gyebrószki Gergely

A demonstráció:

"An Application of the NestList Function" from The Wolfram Demonstrations Project
 http://demonstrations.wolfram.com/AnApplicationOfTheNestListFunction/

Ismertetés:

A demonstrációban a szerző a NestList függvény működését mutatja be. A demonstációt megnyitva két változót (m és n) manipulálva az alábbi parancs eredménye látható:

NestList[(1 + #)^m &, x, n]

n értéke a megadott függvény újbóli alkalmazásainak száma, m értéke pedig a megadott függvényben szereplő hatványkitevő. A csúszkákat mozgatva könnyedén megérthető a NestList függvény működése.

Horváth Gergő

????

A függvény egy bemeneti adatra (jelen esetben X-re) adja meg (((1+X))^m)-t. Ez a függvény van a NestList argumentumában megadva, n-nel együtt, ami azt mondja meg, hogy hányszor hajtsa végre. Mint látható, mind a kettőt tudjuk változtatni Manipulattel.

Kerekes Tamás

Logisztikus leképezés

Hasonlóan a 4. feladatban lévő Volterra egyenletekhez ez a leképezés is a populációdinamikához kapcsolódik. A leképezést matematikailag a következőképpen írhatjuk fel:

(Subscript[x, n+1])=r (Subscript[x, n]) (1-(Subscript[x, n]))

Két alkalmazást jelöltem meg a következő linkekkel, amelyek a NestList parancs felhasználásával megjelenítik a leképezés kaotikus viselkedését. Azért választottam ezeket a példákat, mert érdekel a nemlineáris dinamika és a káosz.

Hyperlink["Iterates, Cycles, and Bifurcations of the Logistic Map", "http://demonstrations.wolfram.com/IteratesCyclesAndBifurcationsOfTheLogisticMap/"]
Hyperlink["Trajectories of the Logistic Map", "http://demonstrations.wolfram.com/TrajectoriesOfTheLogisticMap/"]

Pataki Bernadeth

Kipróbáltam néhány dolgot, amit a dokumentáció szerint végre lehet hajtani NestList-el.

Szolnoki Lénárd

Manipulate[
Pane[
Text@Column@NestList[(1+#)^m&,x,n],{500,400}],
{{m,10},1,20,1,Appearance->"Labeled"},
{{n,10},0,12,1,Appearance->"Labeled"}]

A Manipulate parancsot már ismerjük. Két szabadon választható paraméterünk van, m és n. Ezeket egész értékekre választhatjuk, az Appearence opció a csuszkák mellé írja, hogy éppen mekkora értékéet vesznek fel. A NestList generál nekünk egy egyszerű függvénnyel egy listát. A Column függvény a lista elemeit egy oszlopban kiíratja, a Text pedig a Mathematicai kifejezéseket szöveggé konvertálja. A Pane parancs az egész kimenetet egy fix, 500x400 képpontú téglalapban jeleníti meg.

Timár Máté

(*  1.)  Az alkalmazás az (1+x)^m függvény többszöri(a Manipulate-függvény segítségével állíthatjuk be pontosan mennyi) kompozícióját állítja elő,és az egyes lépéseket listába foglalja. Meghívhatunk hasonlót a következő parancs lefuttatásával:   *)

Manipulate[NestList[(1+#)^m &,x,n],{m,0,10,1},{n,1,10,1}]

Tűri Balázs

A függvényre vonatkozó alkalmazás címe: http://demonstrations.wolfram.com/AnApplicationOfTheNestListFunction/

A kód egy egyszerű, két paraméteres Manipulate parancs. A program a NestList segítségével n-szer alkalmazza az (((1+#))^m) alakú függvényt, ahol a kitevő (m) a másik variálható paraméter. Végeredményként a NestList kimeneti listájának elemeit oszlopba rendezve kapjuk.

2. Használjuk a NestList függvényt a következő számsorozatok tagjainak kiszámolására különböző kezdeti feltételek mellett: (Subscript[a, n]):=3n-5; (Subscript[a, n]):=0.6(Subscript[a, n-1]); (Subscript[a, n]):=((Subscript[a, n-1])+2/(Subscript[a, n-1]))/2;(Subscript[a, n]):=(Subscript[a, n-1])(1-(Subscript[a, n-1])); (Subscript[a, n]):=(Sqrt[2+(Subscript[a, n-1])])
Ábrázoljuk az eredményeket a tagok indexének függvényében a ListPlot függvény felhasználásával.

as

Darvalics Bianka

f[n_]:= 3*n-5

NestList[f,5,24]

NestList[f,13,24]

NestList[f,1,24]

g[n_]:= (0.6^n)

NestList[g,1,5]

NestList[g,3,5]

h[n_]:= n-2/n

NestList[h,2,5]

NestList[h,5,5]

NestList[h,3,5]

i[n_]:= n*(1-n)

NestList[i,2,4]

NestList[i,5,4]

NestList[i,6,4]

j[n_]:= Sqrt[2+n]

NestList[j,2.1,11]

NestList[j,3,4]

NestList[j,4,4]

Gyebrószki Gergely

A számsorozatok:

a1[n_]:=3n-5;
a2[n_]:=0.6n;
a3[n_]:=(n+2/n)/2;
a4[n_]:=n(1-n);
a5[n_]:=(Sqrt[2+n]);

A sorozatok első 5 eleme ((Subscript[a, 0])=4):

NestList[a1,4,5]
NestList[a2,4,5]
NestList[a3,4,5]
NestList[a4,4,5]
NestList[a5,4,5]

TableForm[Transpose[{NestList[a1,4,5],
NestList[a2,4,5],
NestList[a3,4,5],
NestList[a4,4,5],
NestList[a5,4,5]}],TableHeadings->{Range[0,5],{a1,a2,a3,a4,a5}}]

Manipulate[
Show[
If[a1s,ListPlot[NestList[a1,a0,steps],PlotStyle->Red,Joined->True,GridLines->{Table[i,{i,1,steps+1}],None}],ListPlot[NestList[a1,a0,0]]],
If[a2s,ListPlot[NestList[a2,a0,steps],PlotStyle->Green,Joined->True],ListPlot[NestList[a2,a0,0]]],
If[a3s,ListPlot[NestList[a3,a0,steps],PlotStyle->Blue,Joined->True],ListPlot[NestList[a3,a0,0]]],
If[a4s,ListPlot[NestList[a4,a0,steps],PlotStyle->Purple,Joined->True],ListPlot[NestList[a4,a0,0]]],
If[a5s,ListPlot[NestList[a5,a0,steps],PlotStyle->Black,Joined->True],ListPlot[NestList[a5,a0,0]]],
PlotRange->All,AxesOrigin->{0,0},
ImageSize->{400,300},AxesLabel->{"Index","Érték"}
],
{{a0, 2,"Kezdő érték"},-10,10,1,Appearance->"Labeled"},
{{steps, 3,"Lépésszám"},1,20,1,Appearance->"Labeled"},
{{a1s,True,"a1 látható"},{True,False}},
{{a2s,True,"a2 látható"},{True,False}},
{{a3s,True,"a3 látható"},{True,False}},
{{a4s,False,"a4 látható"},{True,False}},
{{a5s,False,"a5 látható"},{True,False}}
]

Manipulate[
 ListPlot[NestList[s, a0, steps], PlotStyle ->  Red, Joined ->  True,GridLines->{Table[i,{i,1,steps+1}],None},Filling->Axis,AxesOrigin->{0,0},ImageSize ->  {400, 300}, AxesLabel ->  {"Index", "Érték"}],
 {{a0, 2,"Kezdő érték"}, -10, 10, 1, Appearance -> "Labeled"},
 {{steps, 3,"Lépésszám"}, 1, 20, 1, Appearance -> "Labeled"},
{{s,a1,"Sorozat"},{a1,a2,a3,a4,a5},ControlType->PopupMenu}
 ]

Horváth Gergő

Az első feladatra nem használnék Nest-et mivel nincs benne rekurzió. Egyszerűen egy függvényt készítenék rá ami

a[n_]=3*n-5

alakú. Ezt le tudom futtatni tetszőleges n-re, vagy egy Table-be téve akár többször egymás után, generálva a keresett listát.

Lássuk a föggvényeket melyek tartalmaznak rakurziót, tehát érdemes Nesttel megvalósítani (az első függvényt, átírtam  (Subscript[a, n]):=3(Subscript[a, n-1])-5 -re és így programoztam le):

ClearAll[f1,f2,f3,f4,f5]
f1:=Function[{x},x*3-5];
f2:=Function[{x},N[0.6*x]];
f3:=Function[{x},N[(((x+(2/x)))/2)]];
f4:=Function[{x},N[x*(1-x)]];
f5:=Function[{x},N[Sqrt[2+x]]];
Manipulate[
NestList[f,x,n],
{{x,1,"Kezdeti érték:"},0,10},{{f,f2,"Függvény:"},{f2,f3,f4,f5}},{{n,10,"Lépésszámláló:"},3,15,1}]

Ábrázoljuk az eredményeket a tagok indexének függvényében a ListPlot függvény felhasználásával.

x=1;n=10;
Manipulate[
ListPlot[{NestList[f1,x,n],NestList[f2,x,n],NestList[f3,x,n],NestList[f4,x,n],NestList[f5,x,n]},PlotRange->{{1,25},{-10,20}},AxesOrigin->{1,0},Filling->Axis],
{{x,1,"Kezdeti érték"},1,30},{{n,10,"Lépésszámláló"},3,25,1}]

Kerekes Tamás

(Subscript[a, n])=3n-5;

Az ilyen típusú sorozatnál nem szükséges a NestList parancs, mert az elemei nem függnek egymástól. A NestList úgy alkalmazható ebben az esetben, hogy a segítségével előállíthatunk egy számsorozatot, amelynek a tagjait behelyettesítjük a megadott összefüggésbe. A Manipulate parancs segítségével kiválasztható a kezdeti feltétel ((Subscript[a, 0])).

Manipulate[Column[{3 NestList[#+1&,a0,8]-5,,,ListPlot[3 NestList[#+1&,a0,8]-5,Filling->Axis,FillingStyle->Red,PlotStyle->Directive[Blue,PointSize[Large]],PlotRange->Full,AxesOrigin->{0,0},ImageSize->Scaled[0.9],AxesLabel->{Style["n",Bold,Larger],Style["(Subscript[a, n])",Bold,Larger]},AxesStyle->Directive[Italic,FontSize->12]]}],{a0,0.1,10}]

(Subscript[a, n])=0.6(Subscript[a, n-1])
(Subscript[a, n])=((Subscript[a, n-1])+2/(Subscript[a, n-1]))/2
(Subscript[a, n])=(Subscript[a, n-1])(1-(Subscript[a, n-1]))
(Subscript[a, n])=(Sqrt[2+(Subscript[a, n-1])])

Ezeknél a számsorozatoknál egyértelmű a NestList parancs előnye, mert a sorozat elemei a korábbi elemekből számolhatóak ki. Felhasználva a Manipulate parancsot kiválasztható, hogy melyik sorozatot szeretnénk megjeleníteni, milyen kezdeti feltétellel ((Subscript[a, 0])).

a2[n_]:=0.6 n
a3[n_]:=(n+2/n)/2
a4[n_]:=n (1-n)
a5[n_]:=Sqrt[2+n]
Manipulate[Column[{N[NestList[a[#]&,a0,8]],,,ListPlot[N[NestList[a[#]&,a0,8]],Filling->Axis,FillingStyle->Red,PlotStyle->Directive[Blue,PointSize[Large]],PlotRange->Full,AxesOrigin->{0,0},ImageSize->Scaled[0.9],AxesLabel->{Style["n",Bold,Larger],Style["(Subscript[a, n])",Bold,Larger]},AxesStyle->Directive[Italic,FontSize->12]]}],{{a,a2,"(Subscript[a, n])="},{a2->"0.6 (Subscript[a, n - 1])",a3->"(1/2)((Subscript[a, n - 1]) + (2/(Subscript[a, n - 1])))",a4->"(Subscript[a, n - 1])(1-(Subscript[a, n - 1]))",a5->"(Sqrt[2 + (Subscript[a, n - 1])])"}},{a0,0.1,10}]

Mucsina Gábor

Manipulate[ListPlot[NestList[#+3 &,u,10]],{u,-10,10,1}]

Manipulate[ListPlot[NestList[#* 0.6 &,u,10]],{u,-5,5,0.5}]

Manipulate[ListPlot[NestList[(#+2/#)/2&,u,10]],{u,-5,5,0.5}]

Manipulate[ListPlot[NestList[#*(1-#)&,u,v]],{{u,1,kezdőérték},-5,5,0.5},{{v,2,Ismétlés},2,10,1}]

Manipulate[ListPlot[NestList[(Sqrt[2+#])&,u,v]],{{u,1,kezdőérték},-2,5,0.5},{{v,2,Ismétlés},2,20,1}]

Szolnoki Lénárd

a1:=NestList[#+3&,-2,20]
a2:=NestList[.6*# &,10.,20]
a3:=NestList[(#+2/#)/2 &,15.,20]
a4 := NestList[# (1-#) &,1.06,20]
a5:=NestList[Sqrt[2+#] &,14.,20]

Manipulate[ListPlot[a ,PlotStyle->Directive[PointSize[Large]],AxesOrigin ->{0,0},PlotRange->All],{{a,a1},{a1->"a1",a2->"a2",a3->"a3",a4->"a4",a5->"a5"}}]

Timár Máté

Forma

(*   2.)    a.)  (Subscript[a, n])=3*n-5     *)

(3*NestList[1+# &,1,6])-5

(*      b.)    (Subscript[a, n])=0.6*(Subscript[a, n])  *)

Manipulate[NestList[0.6 # &,kezdetiertek,m],{kezdetiertek,0.1,5},{m,5,10,1}]

(*      c.)    (Subscript[a, n])=((Subscript[a, n-1])+2/(Subscript[a, n-1]))/2   a (Sqrt[2])-höz tartó rekurzív sorozat, ezért szemléletesebb a számérték kiíratása  *)

Manipulate[N@NestList[(#+2/#)/2 &,kezdetiertek,m],{kezdetiertek,1000,2000},{m,5,15,1}]

(*   d.)  (Subscript[a, n])=(Subscript[a, n-1])*(1-(Subscript[a, n-1]))   *)

Manipulate[N@NestList[# (1-#) &,kezdetiertek,m],{kezdetiertek,0.1,5},{m,5,15,1}]

(*   e.)    (Subscript[a, n])=(Sqrt[2+(Subscript[a, n-1])])       *)

Manipulate[N@NestList[Sqrt[2+#] &,kezdetiertek,m],{kezdetiertek,0.1,5},{m,5,30,1}]

(*     ListPlot:    *)

(*   a.)    *)

ListPlot[(3*NestList[1+# &,1,6])-5,PlotStyle->PointSize[.02]]

(*  b.)   *)

ListPlot[NestList[0.6 # &,2,10],PlotStyle->PointSize[.02]]

(*   c.)  *)

ListPlot[N@NestList[(#+2/#)/2 &,30,15],PlotStyle->PointSize[.01]]

(*  d.)   *)

ListPlot[N@NestList[Sqrt[2+#] &,10000,15],PlotStyle->PointSize[.02],PlotRange->{{0,16},{0,12}}]

Tűri Balázs

an1[n_]:=Table[3 i-5,{i,0,n}]
an2[n_,a0_]:=NestList[Times[0.6,#]&,a0,n]
an3[n_,a0_]:=N[NestList[((#+(2/(#)))/2)&,a0,n]]
an4[n_,a0_]:=NestList[#(1-#)&,a0,n]
an5[n_,a0_]:=NestList[Sqrt[2+#]&,a0,n]/;a0≥-2

ListPlot[an1[10],Filling->Axis]

ListPlot[{an2[10,2],an2[10,-2]},Joined->True,PlotMarkers->Automatic]

ListPlot[{an3[10,-2],an3[10,2],an3[10,0.1],an3[10,-0.1]},PlotStyle->{{PointSize[0.015],Red},{PointSize[0.015],Green},{PointSize[0.015],Blue},{PointSize[0.015],Yellow}}]

ListPlot[{an4[10,0.2],an4[10,-0.1]}]

3. Használjuk a NestList függvényt gyökvonásra. 
newtonstep[x_]:=...

asdf

Darvalics Bianka

NestList[(# + 2/# )/2&,1.0,5]

Gyebrószki Gergely

Keressük meg 12769 gyökét!

Ekkor Newton módszerét használva az alábbi függvényt kell használnunk:

f1[x_]:=(x^2)-12769;
NewtonStep[x_]:=x-((f1[x])/(f1'[x]));

Legyen a fenti szám gyökének első becsült értéke 150

ListPlot[NestList[NewtonStep,150,6],Joined->True]

PlotJoined

Látható, hogy a módszer viszonylag hamar eljut a valós érték közelébe.

A hiba az egyes lépésekben:

N[Table[Sqrt[12769],{i,1,7}]-NestList[NewtonStep, 150, 6],10]

Az alábbi segítségével tanulmányozhatjuk a módszer konvergenciájának sebességét különféle számok gyökeit keresve.

Manipulate[
Column[{
ListPlot[NestList[N[#-((((#)^2)-num)/(2 #)),digits]&,estimate,steps],Joined->True,ImageSize->{400,300},AxesOrigin->{0,Sqrt[num]}],
Row[{"Valós gyök: ",N@Sqrt[num]}],
Row[{"Hiba a ",steps,". lépés után: ",N[Sqrt[num]-Nest[N[#-((((#)^2)-num)/(2 #)),digits]&,estimate,steps],5]}]
}],
{{num,12769,"Szám"},0,100000,1,Appearance->"Labeled"},
{{estimate,150,"Becsült gyök"},1,10000,1,Appearance->"Labeled"},
{{steps,6,"Lépésszám"},1,20,1,Appearance->"Labeled"},
{{digits,50,"Számábrázolás pontossága:"},{10,20,50,100,200}}
]

Látható, hogy ha 0 gyökét keressük és a tippünk (100000) nagyon messze van a valós értéktől, 20 lépés után a hiba 0.1 alatt lesz.

Megjegyzés: azért használom az N[] függvényt a NestList-en belül, mert ellenkező esetben nagyon lassú lenne a számítás. Természetesen ekkor a (10^(-sok)) nagyságrendű hiba értéke nem pontos (ezért lehet kapcsolgatni a számábrázolás pontosságát). Lásd:

Manipulate[
Column[{
ListPlot[NestList[#-((((#)^2)-num)/(2 #))&,estimate,steps],Joined->True,ImageSize->{400,300},AxesOrigin->{0,Sqrt[num]}],
Row[{"Valós gyök: ",N@Sqrt[num]}],
Row[{"Hiba a ",steps,". lépés után: ",N[Sqrt[num]-Nest[#-((((#)^2)-num)/(2 #))&,estimate,steps],5]}]
}],
{{num,12769,"Szám"},0,100000,1,Appearance->"Labeled"},
{{estimate,150,"Becsült gyök"},1,10000,1,Appearance->"Labeled"},
{{steps,6,"Lépésszám"},1,20,1,Appearance->"Labeled"}
]

Horváth Gergő

ClearAll[a,b,d]
Manipulate[
ListPlot[NestList[#-((#^2-d)/(2*#))&,a,b],Filling->Axis,ColorFunctionScaling->"Raindbow"],
{{d,1,"Mely szám négyzetgyöke érdekel?"},1,10000},{{a,1,"Kezdeti érték"},1,100},{{b,1,"Iterációk száma"},1,1000,1}]

A tapasztalatom az volt, hogy mindig beáll a helyes eredményre, az esetek többségében 10 lépésen belül. Nagyjából nagyságrendenként kellett 1-gyel több lépés a helyes eredmény eléréséhez.

Kerekes Tamás

Két módon használható fel a NestList parancs gyökvonáshoz. Az egyik már szerepelt a számsorozatoknál is (harmadik példa). Ez az ún. babiloni módszer.

(Subscript[a, n])=(((Subscript[a, n-1])+(x/(Subscript[a, n-1])))/2)→(Sqrt[x])

Manipulate[N[NestList[(#+S/#)/2&,5,7]],{{S,3,"(Sqrt[x])"},100}]

A másik lehetőség, ha a Newton módszert használjuk

(Subscript[a, n])=(Subscript[a, n-1])+((-f((Subscript[a, n-1])))/(f'((Subscript[a, n-1])))), f((Subscript[a, n]))=((Subscript[a, n])^2)-x

ahol "x" x az a szám, aminek a gyökét keressük.

Másik?

FactorTerms[Apart[(x-(x^2-S)/(2x))]]

Manipulate[N[Nest[#-(#^2-S)/(2 #)&,1,7]],{{S,1,"(Sqrt[x])"},100}]

Mucsina Gábor

szam:=25
indul:= 2
lepes:=12
f[x_]:=(x^2)-szam
step[y_]:=y-f[y]/f'[y]
ListPlot[NestList[step[#] &, indul,lepes],Prolog->Line[{{0,(Sqrt[szam])},{lepes+1,(Sqrt[szam])}}]]

szam:=625
indul:= 4
lepes:=12
ListPlot[NestList[#-(((#)^2)-szam)/(2 #) &, indul,lepes],Prolog->Line[{{0,(Sqrt[szam])},{lepes+1,(Sqrt[szam])}}]]

Pataki Bernadeth

Tanulmányozgassuk a kapott eredményeket.

Szolnoki Lénárd

newtonsqrt[x_,num_]:=NestList[(#+x/#)/2 &,1,num]

Manipulate[Column[N[newtonsqrt[2,n],20]],{{n,4},1,20,1}]

Írtam egy olyan függvényt is, aminek a pontosságot kell beírni az argumentumába leállási feltételnek. A leálláskor a kapott eredmény biztosan van olyan pontos, mint a megadott pontosság, ha 1-nél nagyobb számokat választunk.
Láthatjuk, hogy az algoritmus nagyon gyorsan konvergál.

newtonsqrt2[x_,precision_]:=Catch@Nest[If[Abs[(#+x/#)/2-#]<precision^2/2/#,Throw[#],(#+x/#)/2] &,1,200000]

N[newtonsqrt2[2,0.001],20]

Timár Máté

(*    3.)     *)

(*  Tudjuk,hogy az (Subscript[a, n])=((Subscript[a, n-1])+K/(Subscript[a, n-1]))/2   -rekurzív sorozat K gyökéhez tart,így: *)

NewtonStep[K_,J_]:=N[Nest[(#+K/#)/2 &,K,J],5]

(* Itt "K" az a változó,aminek a gyökét keressük,J a rekurzió mélysége   *)

A gyökkeresést nem Newton - módszerrel csináltam, hanem (szerintem) egy kevésbé számításigényes algoritmussal (ez több lépésben éri el a kívánt eredményt, de nem kell deriválni)

Tűri Balázs

sqrtx[x_,iternum_,initial_,precision_]:=TableForm[SetPrecision[NestList[#-((((#)^2)-x)/(2#))&,initial,iternum],precision]]

Manipulate[sqrtx[x,iternum,initial,precision],{{x,2},ControlType->InputField},{{iternum,3},2,10,1},{{initial,x},0,10},{{precision,10},{5,10,15,20}}]

4. Haladó: Oldjuk meg Euler módszerével a Volterra-Lotka-egyenletet: x'=x-x y   y'=x y -y a következő kezdeti feltétellel: x(0)=2   z(0)=3. Hasonlítsuk össze a kapott eredményeket azzal, amit az NDSolve függvény szolgáltat (remélve, hogy további bugarat nem találunk ☹).

asdf

Darvalics Bianka

ClearAll[EulerMod];
EulerMod[x0_,y0_,t0,f_,h_,var1_:t,var2_:x,var3_:y]:={x0==x[t0];y0==y[t0];t0+h,x0+h (f/.{var1->t0,var2->x0}),t0+h,y0+h (f/.{var1->t0,var2->y0})}

EulerMod[2,3,{x[t]-x[t]*y[t],x[t]*y[t]-y[t]},0.1]

ez ne megy sajnos...

mego1=ParametricPlot3D[Evaluate[{t,x[t],y[t]}/.EulerMod],{t,0,4},AxesLabel->{t,x,y},BoxRatios->{3,1,1}, PlotStyle->{Green, Thick}]

ClearAll[vollot,x,y,t]

vollot=NDSolve[{x'[t]== x[t]-x[t] y[t], y'[t]==x[t] y[t]- y[t],x[0]==2,y[0]==3},{x,y},{t,0,4}]

mego=ParametricPlot3D[Evaluate[{t,x[t],y[t]}/.vollot],{t,0,4},AxesLabel->{t,x,y},BoxRatios->{3,1,1}, PlotStyle->{Green, Thick}]

Gyebrószki Gergely

nds=NDSolve[{x'[t]== x[t]-x[t]y[t],y'[t]== -y[t]+x[t]y[t],x[0]==2,y[0]==3},{x[t],y[t]},{t,0,12}];

xN=Plot[Evaluate[x[t] /. nds],{t,0,12}]
yN=Plot[Evaluate[y[t] /. nds],{t,0,12}]

Definiáljuk a feladat megoldására alkalmas EulerStep függvényt:

EulerStepXY[{τ_, ξ_,η_}, h_, fx_,fy_] := {τ + h, ξ + h*fx[ξ,η],η+h*fy[ξ,η]};

eulSol=NestList[EulerStepXY[#,0.01,Function[{x,y},x-x y],Function[{x,y},x y-y]]&,{0,2,3},1000];

xt=Table[{eulSol[[i]][[1]],eulSol[[i]][[2]]},{i,1,1000}];
yt=Table[{eulSol[[i]][[1]],eulSol[[i]][[3]]},{i,1,1000}];

xE1=ListPlot[xt,PlotRange->All,Joined->True,PlotStyle->Red]
yE1=ListPlot[yt,PlotRange->All,Joined->True,PlotStyle->Red]

Kisebb lépésközzel:

eulSol2=NestList[EulerStepXY[#,0.0005,Function[{x,y},x-x y],Function[{x,y},x y-y]]&,{0, 2,3},24000];

xt2=Table[{eulSol2[[i]][[1]],eulSol2[[i]][[2]]},{i,1,24000}];
yt2=Table[{eulSol2[[i]][[1]],eulSol2[[i]][[3]]},{i,1,24000}];

xE2=ListPlot[xt2,PlotRange->All,Joined->True,PlotStyle->Green]
yE2=ListPlot[yt2,PlotRange->All,Joined->True,PlotStyle->Green]

A megoldások megegyeznek :)

Látható, hogy a nagyobb lépésközzel végzett megoldás (piros) eltér a pontosabb, kisebb lépésközzel végzett megoldástól (zöld)

Az is látszik továbbá, hogy a zöld és a kék (Mathematica NDSolve) fedi egymást!

Show[
xN,xE1,xE2
]

Show[
 yN, yE1, yE2
 ]

Horváth Gergő

StreamPlot[{x-x*y,x*y-y},{x,-20,20},{y,-20,20}]

Kerekes Tamás

Az Euler módszer és a beépített NDSolve összehasonlítása

A következő differenciálegyenlet rendszert kell megoldani numerikus módszer segítségével:

f(x,y)=(OverDot[x])=x-x y
g(x,y)=(OverDot[y])=x y-y

Kezdeti értékek:

x(0)=2
y(0)=3

A következő részben láthatók a numerikus megoldók. Az egyik a Mathematica saját beépített megoldója, az NDSolve, a másik pedig az Euler megoldó, a NestList parancs felhasználásával. Eredményként ábrázoltam az x és y megoldásokat az idő függvényében, illetve a fázisteret (y(x)). Az Euler megoldó eseténél változtatható a lépésköz 0.1-0.01 között.

Clear[x,y,nds]
nds:=NDSolve[{x'[t]==x[t]-x[t] y[t],y'[t]==x[t] y[t]-y[t],x[0]==2,y[0]==3},{x,y},{t,0,10}]
eul[k_,T_]:=Module[{},
step[{τ_,ξ_,η_},h_,f_,g_]:={τ+h,ξ+h f[τ,ξ,η],η+h g[τ,ξ,η]};
sol:=NestList[step[#,k,#2-#2 #3&,#2 #3-#3&]&,{0,2,3},Round[T/k]];
GraphicsGrid[{{Show[ListPlot[Table[{sol[[i,1]],sol[[i,2]]},{i,1,Length[sol]}],PlotStyle->Blue,AxesLabel->{Style["t",Bold,Larger],Style["x(t)",Bold,Larger]},AxesStyle->Directive[Italic,FontSize->12]],Plot[Evaluate[{x[t]}/.nds],{t,0,10},PlotStyle->Red]],
Show[ListPlot[Table[{sol[[i,1]],sol[[i,3]]},{i,1,Length[sol]}],PlotStyle->Blue,AxesLabel->{Style["t",Bold,Larger],Style["y(t)",Bold,Larger]},AxesStyle->Directive[Italic,FontSize->12]],Plot[Evaluate[{y[t]}/.nds],{t,0,10},PlotStyle->Red]]},{
Show[ListPlot[Table[{sol[[i,2]],sol[[i,3]]},{i,1,Length[sol]}],PlotStyle->Blue,AxesLabel->{Style["x",Bold,Larger],Style["y",Bold,Larger]},AxesStyle->Directive[Italic,FontSize->12]],ParametricPlot[Evaluate[{x[t],y[t]}/.nds],{t,0,10},PlotStyle->Red]],SpanFromLeft}},ImageSize->Large]
]

Manipulate[eul[0.1^u,10],{{u,1,"Lépésköz, h="},{1->"0.1",Log[0.1,0.05]->"0.05",2->"0.01"}}]

Egyensúlyi helyek, lineáris stabilitás

Az előbbi megoldás rögzített kezdeti értékekhez tartozik, de a Mathematica eszközeivel egy globális képet is kaphatunk a megoldásokról. A VectorPlot parancs segítségével megjeleníthetőek a trajektóriák. A következő ábrán ez látható, konkrét kezdeti értékekhez tartozó megoldással együtt és az egyensúlyi helyekkel.

Clear[x,y]
n[a_,b_]:=Module[{},
nds:=NDSolve[{x'[t]==x[t]-x[t] y[t],y'[t]==x[t] y[t]-y[t],x[0]==a,y[0]==b},{x,y},{t,0,20}];
Show[VectorPlot[{x-x y,x y-y},{x,-5,5},{y,-5,5},VectorPoints->35,VectorScale->{0.02,Automatic,None},VectorColorFunction->"Rainbow",FrameLabel->{Style["x",Bold,Larger],Style["y",Bold,Larger]},FrameStyle->Directive[Italic,FontSize->12]],ParametricPlot[Evaluate[{x[t],y[t]}/.nds],{t,0,10},PlotStyle->Directive[{Thick,Red}]],Graphics[{PointSize[Large],Red,Point[{0,0}]}],Graphics[{PointSize[Large],Green,Point[{1,1}]}],ImageSize->Large]
]

StreamPlot[{x-x y,x y-y},{x,-5,5},{y,-5,5},VectorPoints->35,VectorScale->{0.02,Automatic,None},VectorColorFunction->"Rainbow",FrameLabel->{Style["x",Bold,Larger],Style["y",Bold,Larger]},FrameStyle->Directive[Italic,FontSize->12]]

Manipulate[n[i,j],{{i,2,"Kezdeti érték: -5 < x(0) < 5"},-5,5},{{j,3,"Kezdeti érték: -5 < y(0) < 5"},-5,5}]

A fixpontok helye és lineáris stabilitásuk jellege meghatározható. A differenciálegyenlet rendszer jobb oldalát egyenlővé kell tenni zérussal és az így kapott algebrai egyenletrendszer megadja az egyensúlyi helyek helyét.

f((Subscript[x, 0]),(Subscript[y, 0]))=0=(Subscript[x, 0])-(Subscript[x, 0]) (Subscript[y, 0])
g((Subscript[x, 0]),(Subscript[y, 0]))=0=(Subscript[x, 0]) (Subscript[y, 0])-(Subscript[y, 0])

Clear[S,X,Y,x,y]
X:=x-x y
Y:=x y-y
Simplify[N[Solve[{0==X,0==Y},{x,y}]]]

Miután linearizáljuk a perturbált egyenleteket, a stabilitásvizsgálat visszavezethető a következő mátrix sajátérték-, sajátvektor-feladatára.

S=(({{1-(Subscript[y, 0]), (Subscript[y, 0])}, {-(Subscript[x, 0]), (Subscript[x, 0])-1}}))

S=(({{D[X,x], D[Y,x]}, {D[X,y], D[Y,y]}}))

Behelyettesítve az egyensúlyi helyek koordinátáit, megkapjuk a lineáris stabilitás jellegét és a hozzá tartozó irányokat (sajátvektorokat). Az ((Subscript[x, 0]),(Subscript[y, 0])) = (0 , 0) egyensúlyi helyhez változó előjelű valós sajátértékek tartoznak, ezért ez egy nyeregpont. Az ((Subscript[x, 0]),(Subscript[y, 0])) = (1 , 1) egyensúlyi helyhez tiszta képzetes sajátértékek tartoznak, ezért ez egy centrum. Ezek a jellegek a fázistér (VectorPlot) ábráján is jól láthatóak.

x:=0
y:=0
Eigenvalues[S]//MatrixForm
Eigenvectors[S]//MatrixForm

x:=1
y:=1
Eigenvalues[S]//MatrixForm
Eigenvectors[S]//MatrixForm

Szolnoki Lénárd

eulermethod[f_,vars_,kf_,h_,num_]:=NestList[{#[[1]]+h,#[[2]]+h*Function[vars,f][#[[1]],#[[2]]]}&,kf,num]

a:=eulermethod[{x[[1]] (1- x[[2]]), x[[2]] (x[[1]]-1)},{t,x},{0,{2,1}},.01,1000]

ListPlot[a[[ ;;1001,2]],AxesOrigin->{0,0},AspectRatio->1]

b=NDSolve[{x'[t]==x[t] (1-y[t]), y'[t]==y[t] (x[t]-1), x[0]==2,y[0]==1}, {x,y},{t,0,10}]

ParametricPlot[Evaluate[{x[t],y[t]}/.b],{t,0,10},AxesOrigin->{0,0},AspectRatio->1]

Látható, hogy a két megoldás igen hasonló, az NDSolve-val kapott megoldás pontosabb, mivel zárt görbét kellett, hogy kapjunk.
StreamPlottal láthatjuk az általános megoldások struktúráját:

StreamPlot[{x (1- y), y (x-1)},{x,0,2},{y,0,2}]

Tűri Balázs

sol=NDSolve[{x'[t]==x[t]-x[t] y[t],y'[t]==x[t] y[t]-y[t],x[0]==2,y[0]==3},{x[t],y[t]},{t,4π}]

f1[x_,y_]:=x-x y
f2[x_,y_]:=x y-y

euler[{x0_,y0_,t0_},step_,stepnum_]:=(
lepes[{ξ_,ψ_,τ_}]:={ξ+h f1[ξ,ψ],ψ+h f2[ξ,ψ],τ+h};
h=step;
NestList[lepes,{x0,y0,t0},stepnum]
)

Show[ListPlot[Map[Delete[#,{3}]&,euler[{2,3,0},0.01,765]]],ParametricPlot[{x[t],y[t]}/.sol,{t,0,4π},PlotStyle->Red]]

5. Maradó: Határozzuk meg egy (egyváltozós, többváltozós) függvény maximális értelmezési tartományát.

asdfg

Szolnoki Lénárd

Egyváltozós függvényre megoldás:

domain[func_]:=Reduce[func[x]∈Reals,x,Reals]

Manipulate[Pane[Column[{TraditionalForm[f[x]=Sqrt[Abs[x]-n]],Plot[Sqrt[Abs[x]-n],{x,-4,4},AxesOrigin->{0,0},PlotRange->{0,2}],
domain[Sqrt[Abs[#]-n] &]}],{300,250}],{{n,3/4},-2,2,1/4},SynchronousUpdating->False]

Composition[Sqrt,Log][x]

domain[Composition[Sqrt,Log]]

domain[Composition[Log,Sqrt]]