Questions and remarks

Martin Hadley a Wolframtól válaszolt a múltkor feltett kérdéseimre, néhol kiegészítem.

1. Is it possible to Import data into a notebook using CDF? Or any other data 
from outside?

Yes! But only via two methods:

EnterpriseCDF: If you have an Enterprise Mathematica license you can save CDF as EnterpriseCDF - this adds a digital signature to the CDF than turns on extra functionality in the Free CDF Player. Namely, import/export and the ability to have InputFields with arbitrary input. Note that you can talk to us about special licenses that allow you to make n EnterpriseCDF...

PlayerPro: This is a purchasable version of the Free CDF Player. This makes all CDF effectively Free CDF. Therefore you can make a FreeCDF using a standard Mathematica license, email it to a user of PlayerPro and they will be able to import/export new data into the CDF.

If either of the CDF types are embedded in a web page the CDF Player it will be impossible for data to be imported/exported to the local machine because the Plugin is sandboxed - however data can be brought into a webembedded EnterpriseCDF via RESTful web methods.

2. What is the real difference between the Student license and the full one?

Okay, there’s a Student or Home Edition Mathematica license you can buy directly from us. These are both limited to four compute kernels, i.e the following will launch 4 KernelObjects.

LaunchKernels[]

A netbookomon is kettő indult el, az irodai gépemen is. Ez utóbbit keveslem, a szerverre belépve biztosan több lesz. Párhuzamos számolásokhoz fontos, hogy minél többet legyen kélpes kezelni a program.

If a student obtains a license from a University with a Comprehensive License then that license will have 8 compute kernels.

There are slightly lower limits on the usage of Wolfram|Alpha for the Home/Student Edition but I can’t put exact numbers on that. Most users will never see the limits effect them.

3. I try to give my lectures in such a way that I am using a clinet machine and the notebook is reached through the local network. When I use Animate or Manipulate sometimes I cannot stop it. A related problem may be that scrolling can also not be halted.

These are web-embedded CDF? There are occasionally these issues, particularly with scrolling. Unfortunately, this is a little bit outside of our control as it’s dependent on how different OS behave with browsers - particularly on OS X the OS doesn’t like releasing the scrolling action from the browser to the sandboxed plugin element.

The only advice I can provide is to switch to DynamicModule and build more restrictive controllers.

Arról van szó (talán), hogy a Manpulate és az Animate alapja a DynamicModule, ez utóbbiból az előbbit össze tudjuk rakni magunk is. És ha nem használjuk, ami készen van meg, hanem magunk rakjuk össze, akkor talán stabilabb lesz.

4. During your talk you used a magnifier. Is it a part of your operating system or is it a part of Mathematica?

This is a part of OS X and is fantastic. System Preferences -> Accessibility -> Use keyboard shortcuts to zoom

Windowsban: MindenProgram|Kellékek|Könnyű kezelés|Nagyító, amint Hegedűs Ádám (másodszr is) elmondta, de utána még mindig meg kell tanulni kezelni.

5. It takes usually very long time if I would like to acquire data from the Wolfram server using any of the functions *Data.

6. If I would like to get information about something what is not an explicit function name than I may get no answer at all, even if the word I have typed in is an Option name. Is this the case you mentioned that you do not really care because there are more important things to do then polishing the help?

There are quite a few undocumented functions,

Ez egy nagyon jópofa EXCEL táblát csinál! De fogalmam sincs, hogyan lehet vele dolgozni. Szóval írnék bele, és menteni akarom. Ki jön rá?

A=TableView[{{a,b},{c,d}}]

abcd
FullForm[A]

TreeForm[A]

A[[1]]

Additionally there are some undocumented Options for functions... I’m struggling to remember one right now, so here’s an undocumented usage of an Option:

RandomGraph[{15,20},VertexLabels->"Name",ImagePadding->12]

Igazából ez nincs annyira eldugva: azt mondja a súgó, hogy ugyanazok az opciói, mint a Graph-nak, ott pedig, ha nem is explicite, de a VertexLabels-re megadott példánál szerepel az ImagePadding. 1. HF.: Változtassuk ImagePadding értékét, hogy rájöjjünk, mit csinál. Persze, a RandomGraph-fal nem fog menni, de a Graph-fal talán igen.

There are plans to improve the documentation. One project that’s ongoing is “Function Essays” - all symbols will have a paragraph of text that will explain what it does/is for.. which may land in M10. The thing that will land is Option autocompletion - including string options.

Anything that’s missing report to us via support@wolfram.com - they are inserted into our bug database almost automatically.

7. Import understands files with the extension .net as well. An important fact (missign from the help) nowadays when so many people are crazy about networks and graphs.

It is missing! Very interesting. I’ve put in a request for future documentation. It’s likely that there’s no documentation because it doesn’t work as broadly as anticipated.

8. Functions

This is how I teach them.

Function[{x}, body]

corresponds exactly to the mathematical form x↦body.

Everyone has learned the identity function of a nonempty set A: (Subscript[id, A])(x):=x  for all x∈A.  (One may write id if the underlying set is the set of real or complex numbers.) This corresponds exactly to the Mathematica form

#&

Similarly, if (Subscript[pr, 1]):X×Y⟶X is defined to be (Subscript[pr, 1])(x,y):=x, then one sees that this function is the same as

#1&

in Mathematica. It would make life easier for the users if we would not say nebulpous sentences about pure functions, slots etc. The above functions are taught at the very beginning of calculus (then they are forgotten also within mathematics...)

So I must admit this is not how calculus was introduced to me. Not sure if you know but there’s the following alternative syntax (infix) for Function:

({x,y}|->{y^2,x})[a,b]

Personally, I’d love to be able to talk about sets but don’t have enough background - therefore the talk about pure functions makes more sense to me.

Szóval inkább bevezetik a tiszta függvényt, meg az anonim függvényt, csak hogy ne kelljen átismételni az elsőéves anyagot analízisből...

Még egy levél (egy valódi mérnök-fizikus barátomtól)

Van egy Raspberry Pi nevezetű kis számítógép, amivel az angol tervezői azt akarják elérni, hogy a gyerekek újra nekiálljanak barkácsolni a mai technikával, és ne csak hülye játékokkal szórakozzanak számukra misztikus ámde teljesen érdektelen gépeken. Konkrétan azt írja valamelyikük, hogy ő a Sinclair Spectrumon nőtt fel, és most nem talált semmi hasonlót a gyerekeinek. Valami tömegtermék telefonos processzorára épül, ezért tud olcsó lenni. Kb. 30 USD és rendes Linux megy rajta. Na, ezt tanulom én most. És az újdonság: megjelent rá a Wolfram féle Mathematica! Ingyen. Wolfram úr beleszeretett a koncepcióba, és erre a masinára korlátozva ingyenessé tette. Berakták az oprendszerbe, ezzel együtt indul a gép. Még egy érdekesség: egy pici alkatrész ellenőrzéséhez szórakozásból csinálok egy képfeldogozós-adagolós kis szekezetet. Körülbelül 100 USD-ből pár napi munkával meglesz. És egy-két nagyságrenddel többet tud majd, mint az az osztályozógép, amit egy japán gépsor végére fejlesztettünk a General Electricnek 90-ben 9.5 Millió forintért.

Szóval meg kell ezt néznünk közelebbről.

Tóth Krisztián tanulságos feladatának - eleje

3. Előkészületek

Clear[y1,y2,y3,res,res1,res2,res3];
y1[x_]:=-31.25x+10000;
y2[x_]:= -2633x+176533;
y3[x_]:= -0.167x+111.24;
res1= {#,y1[#]}&/@Range[0,64,64/100];
res2={#,y2[#]} &/@Range[64,67,3/100];
res3= {#,y3[#]} &/@Range[67,100,33/50];
res1=Take[res1,100];
res2=Take[res2,-1*Length[res2]+50];
res2=Take[res2,Length[res2]-35];
res3=Take[res3,-50];

res=Union[res1,res2,res3];
ListPlot[res,PlotLabel->"Csúnya vagyok,\nmert pontonként lettem definiálva.\n"]

Clear[modell]
modell=Interpolation[res];
Plot[modell[x],{x,0,100},PlotStyle->Thick,ImageSize->Large]

Plot[Interpolation[res,InterpolationOrder->1][x],{x,0,100},PlotStyle->Thick,ImageSize->Large,PlotLabel->Style["Nem kell haramdfokú interpolációs polinom,\n elsőfokúval is szép lesz az ábra.",Background->Yellow]]

Figyeljék meg szakaszonkét deinált függvény megadásának egyik módját.

modell2[x_]:=Piecewise[{{-31.25x+10000,0<=x<=64},{-2633x+176533,64<=x<=67},{-0.167x+111.24,67<=x≤100}}]

Plot[modell2[x],{x,0,100}]

2. HF.: Definálják más módon is ezt a függvényt (Which, Switch, UnitStep, Boole, If, Condition stb.), majd ábrázolják is.

Itt egy (közelítőleg nem rossz) modell.

nds=NDSolve[{T'[t]==-0.07(T[t]-20)+0.9 (((Sqrt[2])220((Cos[50 2π t])^2))/(modell2[T[t]]0.7 1.0)),T[0]==20},T,{t,0,100},MaxSteps->500000]

Plot[T[t]/.nds,{t,0,100}]

Hogyan jött ki a -0.07 érték? Tegyük fel, hogy a kemencéből kivett 100 fokos kenyér 10 perc alatt 50 fokra hűl le. Innen:

ds=First@DSolve[{T'[t]==k(T[t]-273),T[0]==373},T,t]

(T[10]/.ds)==323

Solve[(E^(10 k))==1/2,k,Reals][[1]]

N[k/.%]

A 0.9-es együttható a melegítés hatásfoka, a hasamra ütöttem. 0.7 a (Subscript[SiO, 2]) fajlagos hőkapacitása. 1.0 az ellenállás tömege, nem értem, attól miért függene az eredmény. Azt gondolom, váltóáramunk van, tehát (Sqrt[2])220Cos[50 2π t] adja meg az ármforrás feszültségét a t időpontban, felül lehet bírálni. Amíg nem vettem figyelembe, hogy a frekvencia 50 Hz, addig ezt írtam:

nds2=NDSolve[{T'[t]==-0.07(T[t]-20)+0.9 (((Sqrt[2])220((Cos[2π t])^2))/(modell2[T[t]]0.7 1.0)),T[0]==20},T,{t,0,150}]

Plot[T[t]/.nds2,{t,20,30},PlotLabel-> "És mennyivel érdekesebb eredményt kaptam még akkor!"]

Nyilván az előző görbén is van rárakódott hullámzás, csak nagyon kicsi amplitúdóval.

3. HF.: Bonyolítsuk értelmes módon a rendszert (miután a modellbe általam belerakott hibákat sikerült kijavítani), és tanulmányozzuk a viselkedését. Például a fenti példában kicsi volt a melegedés, örültünk, ez volt a cél. De ha épp fűteni akarunk? És mi történik, ha az áram tekercsen vagy kondenzátoron folyik át? Kapcsolgassunk össze ilyeneket stb.

Megoldott házik

Itt a sárga újabb házit jelent.

Tóth Krisztián

Rajzoljuk meg a fázissíkot kétváltozós lineáris rendszerek összes kvalitatíve különböző esetére. Tehát az egyenlet:

{x'[t]==a x[t]+b y[t],y'[t]==c x[t]+d y[t]}

és az A={{a,b},{c,d}} mátrix sajátértékei valósak, különbözők, egybeesők, komplexek stb.

phasePortrait[mat_]:=Module[{},Column[{MatrixForm[mat],StreamPlot[mat.{x,y},{x,-1,1},{y,-1,1},PlotLabel->"Eigenvaules: "<>ToString[Eigenvalues[mat]]<>"\n" ]}]]

Map[phasePortrait,{{{1,0},{0,-1}},{{1,-1},{1,1}},{{1,1},{0,1}},{{1,-1},{1,-1}},{{0,-1},{1,0}},{{0,0},{0,-1}}}]

1. HF.: Egészítsük ki a programot azzal, hogy írja ki a stacionárius pont típusát is: nyereg, instabil, stabil, csomó, fókusz, centrum, egytengelyű csomó

A stacionárius pont típusának meghatározásához nem kell feltétlenül kiszámolni a sajátértékeket, azt a mátrix determinánsa és nyoma egyértelműen meghatározza.

det A < 0 nyereg 
det A < tr2 A / 4 csomó (stabil vagy instabil)
det A > tr2 A / 4fókusz (stabil vagy instabil)
det A = 0 nyeregcsomó
det A > 0 és tr A = 0 centrum
det A = tr2 A / 4 egytengelyű csomó

StationaryPoint[mat_]:=Module[{},Column[{If[Det[mat]<0 ,"nyereg",""],If[Det[mat]>0 && Tr[mat]==0,"centrum",If[Det[mat]>(((((Tr[mat])/2)))^2),"fókusz",""]],If[Det[mat]==(((((Tr[mat])/2)))^2),"egytengelyű csomó",If[Det[mat]==0 ,"nyeregcsomó",If[Det[mat]< (((((Tr[mat])/2)))^2),"csomó",""]]]}]];

A fő megjegyzésem, hogy kerüljük az egymásbaskatulyázott If-eket. Ami alább van, programozási minta, majd kijavítom szakmai szempontból később.

SP2[A_]:=With[{d=Det[A],t=Tr[A]},Which[d<0,"nyereg",(d<((t^2)/4))∧(t<0),"stabilis csomó",(d<((t^2)/4))∧(t>0),"istabilis csomó",(d==((t^2)/4))∧(t<0),"stabilis degenerált csomó",(d==((t^2)/4))∧(t>0),"instabilis degenerált csomó",d>0 ∧ t== 0,"centrum",d>(t^2)/4∧t<0,"stabilis fókusz",d>(t^2)/4∧t>0,"instabilis fókusz",d>0∧ t== 0,"centrum",d==0,"nyeregcsomó"]]

phasePortrait2[mat_]:=Module[{},Column[{MatrixForm[mat],StreamPlot[mat.{x,y},{x,-1,1},{y,-1,1},PlotLabel->"Eigenvalues: "<>ToString[Eigenvalues[mat]]<>"\n" <>"Stacionarius pont típusa: "<> ToString[StationaryPoint[mat]]]}]]

Map[phasePortrait2,{{{1,0},{0,-1}},{{1,-1},{1,1}},{{1,1},{0,1}},{{1,-1},{1,-1}},{{0,-1},{1,0}},{{0,0},{0,-1}}}]

De a lényeg, hogy megvan!

Fázisegyenes

phaseLine1[rhsfunval_]:=Module[{},pnds=ParametricNDSolve[{x'[t]== x[t](1-x[t]),x[0]==x0},x,{t,-2,2},{x0}];
pl2=Plot[Evaluate[Table[x[x0][t] /. pnds, {x0, -.1, 1.1, .2}]], {t, 0,2}, PlotRange -> {-2,2},AspectRatio->GoldenRatio,PlotStyle->Directive[Thickness[0.01]]];
rhs=ParametricPlot[{-x(1-x),x},{x,-.2,1.2},PlotStyle->Directive[Red,Thick]];
plr=Show[rhs,pl2,PlotRange->{-0.5,1.2}];
sp=StreamPlot[{1,x(1-x)},{t,-1,1},{x,-2,2}];
ph=Graphics[{Thick,Line[{{0,-2},{0,2}}],PointSize[Large],Point[{0,0}],Point[{0,1}],Arrowheads[Large],Arrow[{{0,0},{0,-0.4}}],Arrow[{{0,0},{0,0.75}}],Arrow[{{0,1.5},{0,1.25}}]}];
GraphicsColumn[{GraphicsRow[{sp,plr,ph}],
Show[sp,plr,ph,PlotRange->{{-0.5,1.0},{-0.5,1.5}}]}]]

2. HF.: Rajzoljunk nyilat az egyenesre, amely mutatja a trajektóriák haladásának irányát. Szorgalmi: a megoldásokra is!

phaseLine1[x(1-(x^2))]

3. HF.: Alkalmazzuk minél többre, hogy kiderüljenek a hibái. Fejlesszük, ami nem jó benne. (Kétváltozós rendszerek?)

phaseLine4[rhsfunval_]:=Module[{pnds,pl2,rhs,plr,sp,ph,from,to,sol},pnds=ParametricNDSolve[{x'[t]== (rhsfunval/.{x->x[t]}),x[0]==x0},x,{t,-2,2},{x0}];
pl2=Plot[Evaluate[Table[x[x0][t] /. pnds, {x0, -.1, 1.1, .2}]], {t, 0,2}, PlotRange -> {-2,2},AspectRatio->GoldenRatio,PlotStyle->Directive[Thickness[0.01]]];
rhs=ParametricPlot[{-rhsfunval,x},{x,-2,2},PlotStyle->Directive[Red,Thick]];
plr=Show[rhs,pl2,PlotRange->{-0.5,1.2}];
sol=Solve[rhsfunval==0,x,Reals];
from=Min[x/.sol];to=Max[x/.sol];
sp=StreamPlot[{1,rhsfunval},{t,-2,2},{x,from-1,to+1}];
ph=Graphics[Join[{Thick,Line[{{0,from-1},{0,to+1}}]},Prepend[Point[{0,#}]&/@(x/.sol),PointSize[Large]]]];
Column[{GraphicsRow[{sp,plr,ph}],Show[sp,plr,ph,PlotRange->{{from-1,to+1},{from-1,to+1}}]}]]

phaseLine4[x(1-(x^2))]

phaseLine4[x(1-x)(x+2)]

phaseLine1[x(1-x)(x+2)]

phaseLine4[(x^2)-3 x]

phaseLine4[-0.2x+Sin[x] ]

phaseLine1[-0.2x+Sin[x]]

phaseLine4[0.2x+Sin[x] ]

Plot[(x^3)-3x+2,{x,-3,2},Filling->Bottom,PlotLabel->"Működik-e a nyilazás egy ilyen jobb oldalra is?\n Mert itt nem váltakozik az irány!",Epilog->{Red,PointSize[Large],Point[{1,0}]}]

Holló Gábor

1. HF.: Egészítsük ki a programot azzal, hogy írja ki a stacionárius pont típusát is: nyereg, fókusz stb.

phasePortraithg[mat_]:=Module[{},Column[{MatrixForm[mat],StreamPlot[mat.{x,y},{x,-1,1},{y,-1,1},PlotLabel->"Eigenvaules: "<>ToString[Eigenvalues[mat]]<>"\n"<>If[Det[mat]<0,"Nyereg",If[Det[mat]==0,Which[Tr[mat]<0,"Stabil egyensúlyi vonal",Tr[mat]>0,"Instabil egyensúlyi vonal",Tr[mat]==0,"Valami"],If[Tr[mat]==0,"Centrum",Which[Tr[mat]<0,"Stabil ",Tr[mat]>0,"Instabil "]<>Which[Det[mat]<Tr[mat]^2/4,"csomó",Det[mat]==Tr[mat]^2/4,"egytengelyű csomó",Det[mat]>Tr[mat]^2/4,"fókusz"]]]]<>"\n"]}]]

Map[phasePortraithg,{{{2,0},{0,1}},{{-2,0},{0,-1}},{{1,0},{0,-1}},{{1,-1},{1,1}},{{1,1},{0,1}},{{1,-1},{1,-1}},{{0,-1},{1,0}},{{0,0},{0,-2}}}]

4. HF.: Tekintsük ezt: f(a,b,x):=a x-(x^3)-b. Bifurkációs görbék: f(1,b,x),f(0,b,x),f(-1,b,x). Többi a esetén?

bif[rhsfun_]:=Manipulate[Plot[x/.Solve[rhsfun==0,x],{a,-2,2},AxesLabel->{a,SubStar[x]},LabelStyle->Directive[Bold],PlotRange->{-2,2},PerformanceGoal->"Quality"],{b,-2,2,0.1}]

bif[a x-x^3-b]

Manipulate[StreamPlot[{t,a[[1]] x-x^3-a[[2]]},{t,0,2},{x,-3,3},PerformanceGoal->"Quality"],{a,{-2,-2},{2,2},{0.1,0.1}}]

4. HF.: Figyeljék meg a kétdimenziós csúszkát (Slider2D), és a súgó alapjáűn mutassanak egy-két másféle szép alkalmazást.

5. HF.: Keressenek ilyesmit a demonstrations.wolfram.com honlapon, és röviden ismertessenek egy-egyet közülük:

demo : poincaré map -disk

Hyperlink["Iránytű", "http://demonstrations.wolfram.com/CompassNeedleInUniformAndRotatingMagneticFields/"]

Iránytű viselkedése mágneses térben

Egy iránytű mozgását írták le állandó és változó mágneses térben. Figyelembe vették a tű tehetetlenségét, illetve az energiadisszipációt (közegellenállást) is. A kaotikus rendszer viselkedése követhető az idő függvényében, a fázissíkon valamint a Poincaré-leképezés segítségével is.

demo : bifurcation
   
Hopf bifurkáció a Brüsszelátor modellben.
      A modell : A -> X; 2 X + Y -> 3 X; B + X -> Y + C; X -> D
Az ábrán egy kocka két oldalán láthatók a trajektóriák, a köztitermékek időfüggése, egy harmadik oldalon pedig a fázissíkot jelenítették meg, ahol adott paraméterek mellett megfigyelhető a periodikus határciklus is.

Hyperlink["Brusselator", \
  "http://demonstrations.wolfram.com/HopfBifurcationInTheBrusselator/"]

Első integrálok

Az x'=y, y'=-x harmonikus oszcillátornak a (p,q)↦V(p,q):=(p^2)+(q^2)  függvény első integrálja, mert értéke az egyenlet megoldásainak mentén állandó, ami azzal egyenértékű, hogy deriváltja a megoldások mentén nulla: (d/(dt))(V(x(t),y(t)))=(2x(t),2y(t)).(({{x'(t)}, {y'(t)}}))=0.  Ez egyrészt azt jelenti, hogy a megoldások az első integrál szintvonalain haladnak, másrészt azzal az előnnyel járhat, hogy az egyik változó kifejezhető, csökkentenitudjuk az egyenletek számát.

Feladatok: (Format|Style|ItemNumbered: így hoztam létre az alábbit.)

Verifikálás: adott az egyenlet, meg a szóba jövő függvény, nézzük meg, hogy első integrál-e.

Adott az egyenlet, keressünk hozzá első integrálokat. Ez a fő feladat, nehéz. De ha találtunk sokat, akkor sokkal csökkenthetjük az egyenletek számát.

Tréfás feladat (nem teljesen értelmetlen): adott egy első integrál, keressünk hozzá differenciálegyenletet. Mivel programozási szemntból tanulságos, ezt fogjuk megoldani.

De akit érdekel a téma, az például nézze meg ezt:

Hyperlink["Elso Integral","http://www.math24.net/first-integrals.html"]

(bár nem úgy van leírva, ahogyan én szeretem...)

Eleje

D[x+y+z-Log[x]-Log[y]-Log[z],{{x,y,z}}]

rhs1=({x,y,z}.{{a,b,c},{d,e,f},{g,h,j}}.{x,y,z}+{k,l,m}.{x,y,z}+n//Expand)

rhs2=({x,y,z}.{{A,B,CC},{DD,EE,F},{G,H,J}}.{x,y,z}+{k,l,m}.{x,y,z}+NN//Expand)

rhs3=({x,y,z}.{{α,β,χ},{δ,ϵ,ϕ},{γ,η,φ}}.{x,y,z}+{κ,λ,μ}.{x,y,z}+ν//Expand)

ClearAll[kif];kif[x_,y_,z_]=D[x+y+z-Log[x]-Log[y]-Log[z],{{x,y,z}}].{rhs1,rhs2,rhs3}//Expand

kif2=-k-l+n+NN-(n/x)-a x-B x-DD x+2 k x+a (x^2)+A (x^2)-(NN/y)-((k x)/y)-((A (x^2))/y)-b y-d y-EE y+2 l y-((l y)/x)+b x y+B x y+d x y+DD x y+e (y^2)+EE (y^2)-((e (y^2))/x)-c z-F z-g z-H z+2 m z-((m z)/x)+c x z+CC x z+g x z+G x z-((m z)/y)-((CC x z)/y)-((G x z)/y)+f y z+F y z+h y z+H y z-((f y z)/x)-((h y z)/x)+j (z^2)+J (z^2)-((j (z^2))/x)-((J (z^2))/y)+(x^2) α-(((x^2) α)/z)+x y β-((x y β)/z)-x γ+x z γ+x y δ-((x y δ)/z)+(y^2) ϵ-(((y^2) ϵ)/z)-y η+y z η+x κ-((x κ)/z)+y λ-((y λ)/z)-μ+z μ+ν-(ν/z)-y ϕ+y z ϕ-z φ+(z^2) φ-x χ+x z χ/.{n->0,NN->0,ν->0,k->0,A->0,l->0,e->0,m->0,CC->0,G->0,f->0,h->0,j->0,J->0,α->0,β->0,δ->0,ϵ->0,κ->0,λ->0}

kif3=kif2/.{μ->0,a->0,EE->0,φ->0}

Simplify[((-1)/z)kif3/.{x->0,y->0}]

Simplify[((-1)/x)kif3/.{z->0,y->0}]

Simplify[((-1)/y)kif3/.{z->0,x->0}]

Coefficient[kif3,x y]

Coefficient[kif3,x z]

Coefficient[kif3,y z]

sol=Solve[{c+F+g+H==0,B+DD+γ+χ==0,b+d+η+ϕ==0,b+B+d+DD==0,c+g+γ+χ==0,F+H+η+ϕ==0},Union[{c,F,g,H,B,DD,γ,χ,b,d,η,ϕ,b,B,d,DD,c,g,γ,χ}]]

(rhs1/.{n->0,NN->0,ν->0,k->0,A->0,l->0,e->0,m->0,CC->0,G->0,f->0,h->0,j->0,J->0,α->0,β->0,δ->0,ϵ->0,κ->0,λ->0,μ->0,a->0,EE->0,φ->0}/.sol)/x//Apart

(rhs2/.{n->0,NN->0,ν->0,k->0,A->0,l->0,e->0,m->0,CC->0,G->0,f->0,h->0,j->0,J->0,α->0,β->0,δ->0,ϵ->0,κ->0,λ->0,μ->0,a->0,EE->0,φ->0}/.sol)/y//Apart

(rhs3/.{n->0,NN->0,ν->0,k->0,A->0,l->0,e->0,m->0,CC->0,G->0,f->0,h->0,j->0,J->0,α->0,β->0,δ->0,ϵ->0,κ->0,λ->0,μ->0,a->0,EE->0,φ->0}/.sol)/z//Apart

CoefficientArrays[kif2,{x,y,z}]

%27[[3]]//Normal

Normal/@CoefficientArrays[kif3,{x,y,z}]

ClearAll[kif];kif[x_,y_,z_]=D[x+y+z-Log[x]-Log[y]-Log[z],{{x,y,z}}].{rhs1,rhs2,rhs3}//Expand

Újratervezés

V[p_,q_,r_]:=p+q+r-Log[p]-Log[q]-Log[r]

D[Sin[x],{x,2}]

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

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

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

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

D[Sin[x y],{{x,y},2}]//MatrixForm

ljapderiv=D[(Subscript[x, 1])+(Subscript[x, 2])+(Subscript[x, 3])-Log[(Subscript[x, 1])]-Log[(Subscript[x, 2])]-Log[(Subscript[x, 3])],{{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3])}}]

D[V[p,q,r],{{p,q,r}}]

ClearAll[rhs];
rhs[m_]:=Expand[{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3])}.{{(Subscript[a, m]),(Subscript[b, m])/2,(Subscript[c, m])/2},{(Subscript[b, m])/2,(Subscript[d, m]),(Subscript[e, m])/2},{(Subscript[c, m])/2,(Subscript[e, m])/2,(Subscript[f, m])}}.{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3])}+{(Subscript[g, m]),(Subscript[h, m]),(Subscript[i, m])}.{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3])}+(Subscript[j, m])]

rhs/@Range[3]

Expand[ljapderiv.rhs/@Range[3]]

expr=Expand[ljapderiv.rhs/@Range[3]]/.{((Subscript[x, m_])^(-1))-> (Subscript[ξ, m])}

col=Column@(Normal/@CoefficientArrays[expr,{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3]),(Subscript[ξ, 1]),(Subscript[ξ, 2]),(Subscript[ξ, 3])}])

eq=Thread[Cases[Flatten[Normal/@CoefficientArrays[expr,{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3]),(Subscript[ξ, 1]),(Subscript[ξ, 2]),(Subscript[ξ, 3])}]],Except[0]]==0]

sol=First@Solve[eq]

rhs[1]/.sol

rhs[2]/.sol

rhs[3]/.sol

Általánosan

ClearAll[ljapderiv];
ljapder[M_]:=Module[{X=Array[(Subscript[x, #])&,M]},D[Total@X-Total@(Log@X),{X}]]
ljapder[3]

Szimmetrikus mátrixot csinálunk kvadratikus alakhoz. A beépített nem tetszik:

Normal@Symmetrize[{{a,b},{c,d}}]

A[M_,m_]:=(1/2)Array[(Subscript[Superscript[a,m], #1,#2])&,{M,M}]+(1/2)DiagonalMatrix[Array[(Subscript[Superscript[a,m], #1,#1])&,{M}]]/.{(Subscript[Superscript[a,m], i_,j_]):>(Subscript[Superscript[a,m], j,i])/;i<j}

b[M_,m_]:=Array[(Subscript[Superscript[b,m], #1])&,{M}]

b[3,2]

c[M_]:=Array[Superscript[c,#]&,{M}]

c[3]

ClearAll[rhs];
rhs[M_,m_]:=Module[{X=Array[(Subscript[x, #])&,M]},Expand[X.A[M,m].X+b[M,m].X+c[M][[m]]]]
rhs[3,2]

rhs[3,2]

ki=Expand[ljapder[3].(rhs[3,#]&/@Range[3])]/.{((Subscript[x, m_])^(-1))-> (Subscript[ξ, m])}

X=Array[(Subscript[x, #])&,3];
Ξ=Array[(Subscript[ξ, #])&,3];Join[X,Ξ]

eq=Thread[Cases[Flatten[Normal/@CoefficientArrays[ki,Join[X,Ξ]]],Except[0]]==0]

sol=First@Solve[eq]

rhs[3,1]/.sol

rhs[3,2]/.sol

rhs[3,3]/.sol

Összeszedjük az általánosat

ClearAll[vl];vl[M_]:=Module[{X=Array[(Subscript[x, #])&,M],Ξ=Array[(Subscript[ξ, #])&,M],ljd,ki,eq,sol},ljd=D[Total@X-Total@(Log@X),{X}];
A[m_]:=(1/2)Array[(Subscript[Superscript[a,m], #1,#2])&,{M,M}]+(1/2)DiagonalMatrix[Array[(Subscript[Superscript[a,m], #1,#1])&,{M}]]/.{(Subscript[Superscript[a,m], i_,j_]):>(Subscript[Superscript[a,m], j,i])/;i<j};
B[m_]:=Array[(Subscript[Superscript[b,m], #1])&,{M}];
CC:=Array[Superscript[c,#]&,{M}];
rhs[m_]:=Expand[X.A[m].X+B[m].X+CC[[m]]];ki=Expand[ljd.(rhs[#]&/@Range[M])]/.{((Subscript[x, m_])^(-1))-> (Subscript[ξ, m])};eq=Thread[Cases[Flatten[Normal/@CoefficientArrays[ki,Join[X,Ξ]]],Except[0]]==0];
sol=First@Solve[eq];MatrixForm[(rhs[#]&/@Range[M])/.sol]]
vl[3]

vl[2]

vl[2]/.(Subscript[(Superscript[b, 2]), 2])->-1

vl[1]

vl[4]

HF.: Határozzuk meg azokat a polinomiális egyenleteket, amelyeknek első integrálja a változók négyzetének összege.

f[k_,n_]:=Sum[(i^k),{i,1,n}]

f[1,n]

f[2,n]

f[k,n]

Ez már nem

Funkcionális programozásról

eulerstep[rhsfun_,h_][{τ_,ξ_}]:={τ+h,ξ+h rhsfun[τ,ξ]}

NestList[eulerstep[#1 #2&,0.1][#]&,{1,1},3]

nl[k_,h_:0.1]:=NestList[eulerstep[#1 #2&,h][#]&,{1,1},k]

ds=First@DSolve[{x'[t]==t x[t],x[1]==1},x[t],t]

ClearAll[lp];lp[k_,h_:0.1]:=ListPlot[nl[k,h]]

lp[12]

ClearAll[pl];pl[k_,h_:0.1]:=Plot[x[t]/.ds,{t,1,1+k h}]

Show[lp[20],pl[20]]

Show[lp[20,0.05],pl[20,0.05]]

Show[lp[20,0.005],pl[20,0.005]]

Írjunk programot a legnagyobb közös osztó előállítására az eukleidészi algoritmus alapján.

szukcappr

NestList[Cos,1.5,5]

FixedPoint[Cos,1.0]

Mintaillesztésről

1.//x_->Cos[x]

mymap[fun_,lis_]:=mymap[fun,{},lis];
mymap[fun_,{x___},{y_,z___}]:=mymap[fun,{x,fun[y]},{z}];
mymap[fun_,lis_,{}]:=lis;

Írjuk meg a myapply-t.

Még mindig differenciálegyenletek

Előző házi feladatok

Ezekhez kapcsolódó új feladatok jönnek, illetve az órán is beszéltem a megoldásukról. Csak az utolsóhoz másolom be Holló Gábor megoldásait egy kis (előremutató:)) kiegészítéssel. Az új házi feladatok a szöveg között találhatók.

Tanulmányozzuk a logisztikus egyenletet azzal a feltétellel, hogy szüretelünk is, vagy másképp lehalásszuk a halak egy részét, mégpedig állandó sebességgel, azaz tekintsük ezt az egyenletet:

x'[t]==x[t](1-x[t])-h

ahol h pozitív állandó. Ennek értékétől hogyan függ a rendszer viselkedése?

Mi a helyzet periodikus lehalászás esetén, azaz itt:

x'[t]==5x[t](1-x[t])-0.8(1+Sin[2π t])

Rajzoljuk meg a fázisegyenest az alábbi egyenlethez:

x'[t]==x[t](1-x[t])(x[t]-4)

Rajzoljuk meg a fázisegyenest az alábbi egyenlethez:

α'[t]==A Exp[-(E/(R ((Subscript[T, 0])+β t)))](((1-α[t]))^n)

Itt minden együttható pozitív, kivéve n -et, ez lehet 0,1,2,3.

Rajzoljuk meg a fázissíkot kétváltozós lineáris rendszerek összes kvalitatíve különböző esetére. Tehát az egyenlet:

{x'[t]==a x[t]+b y[t],y'[t]==c x[t]+d y[t]}

és az A={{a,b},{c,d}} mátrix sajátértékei valósak, különbözők, egybeesők, komplexek stb.

A={{1,0},{0,1}};
MatrixForm[A]
Eigenvalues[A]
StreamPlot[{A[[1,1]] x+A[[1,2]]y,A[[2,1]]x+A[[2,2]] y},{x,-1,1},{y,-1,1}]

Először is: a mátrixvektor-szorzás használható.

A.{x,y}

Persze, hogy nem változik, hiszen most A az egységmátrix!

Másodszor: Mindig ugyanazt csináljuk; szedjük össze amink van, és írjuk egy programot, ami automatizálja a folyamatot.

phasePortrait[mat_]:=Module[{},Column[{MatrixForm[mat],StreamPlot[mat.{x,y},{x,-1,1},{y,-1,1},PlotLabel->"Eigenvaules: "<>ToString[Eigenvalues[mat]]<>"\n"]}]]

Próbáljuk ki az előző feladaton. (A felirat után beraktam egy új sort, hogy ne tapadjon az ábárhoz.)

phasePortrait[A]

phasePortrait[{{-1,0},{0,-1}}]

Megtáltosodunk. A többit egy csapásra intézzük el.

Map[phasePortrait,{{{1,0},{0,-1}},{{1,-1},{1,1}},{{1,1},{0,1}},{{1,-1},{1,-1}},{{0,-1},{1,0}},{{0,0},{0,-1}}}]

1. HF.: Egészítsük ki a programot azzal, hogy írja ki a stacionárius pont típusát is: nyereg, fókusz stb.

A Cell|DeleteAllOputput utasítást már menet közben is kiadom, hogy az időszakos mentés ne menjen oly lassan.

Fázisegyenes, bifurkáció, Poincaré-leképezés szüretre (lehalászás), fázissík

Fázisegyenes

Megcsináljuk lépésenként, majd összerakjuk.

pnds=ParametricNDSolve[{x'[t]== x[t](1-x[t]),x[0]==x0},x,{t,-2,2},{x0}]

pl2=Plot[Evaluate[Table[x[x0][t] /. pnds, {x0, -.1, 1.1, .2}]], {t, 0,2}, PlotRange -> {-2,2},AspectRatio->GoldenRatio,PlotStyle->Directive[Thickness[0.01]]]

rhs=ParametricPlot[{-x(1-x),x},{x,-.2,1.2},PlotStyle->Directive[Red,Thick]]

Figyeljük meg, hogyan készült az elforgatott görbe.

plr=Show[rhs,pl2,PlotRange->{-0.5,1.2}]

sp=StreamPlot[{1,x(1-x)},{t,-1,1},{x,-2,2}]

ph=Graphics[{Thick,Line[{{0,-2},{0,2}}],PointSize[Large],Point[{0,0}],Point[{0,1}]}]

2. HF.: Rajzoljunk nyilat az egyenesre, amely mutatja a trajektóriák haladásának irányát. Szorgalmi: a megoldásokra is!

GraphicsRow[{sp,plr,ph}]

Show[sp,plr,ph]

Szedjük össze. Három alapvető konstrukció van: Module, Block, With

Idemásolom a lépéseket.

pnds=ParametricNDSolve[{x'[t]== x[t](1-x[t]),x[0]==x0},x,{t,-2,2},{x0}]

pl2=Plot[Evaluate[Table[x[x0][t] /. pnds, {x0, -.1, 1.1, .2}]], {t, 0,2}, PlotRange -> {-2,2},AspectRatio->GoldenRatio,PlotStyle->Directive[Thickness[0.01]]]

rhs=ParametricPlot[{-x(1-x),x},{x,-.2,1.2},PlotStyle->Directive[Red,Thick]]

plr=Show[rhs,pl2,PlotRange->{-0.5,1.2}]

sp=StreamPlot[{1,x(1-x)},{t,-1,1},{x,-2,2}]

ph=Graphics[{Thick,Line[{{0,-2},{0,2}}],PointSize[Large],Point[{0,0}],Point[{0,1}]}]

GraphicsRow[{sp,plr,ph}]

Show[sp,plr,ph]

Értelmetlenül bepakolom egy Module-ba, csak azért, hogy lássuk annak a szintaxisát.

phaseLine1[rhsfunval_]:=Module[{},pnds=ParametricNDSolve[{x'[t]== x[t](1-x[t]),x[0]==x0},x,{t,-2,2},{x0}];
pl2=Plot[Evaluate[Table[x[x0][t] /. pnds, {x0, -.1, 1.1, .2}]], {t, 0,2}, PlotRange -> {-2,2},AspectRatio->GoldenRatio,PlotStyle->Directive[Thickness[0.01]]];
rhs=ParametricPlot[{-x(1-x),x},{x,-.2,1.2},PlotStyle->Directive[Red,Thick]];
plr=Show[rhs,pl2,PlotRange->{-0.5,1.2}];
sp=StreamPlot[{1,x(1-x)},{t,-1,1},{x,-2,2}];
ph=Graphics[{Thick,Line[{{0,-2},{0,2}}],PointSize[Large],Point[{0,0}],Point[{0,1}]}];
GraphicsColumn[{GraphicsRow[{sp,plr,ph}],
Show[sp,plr,ph,PlotRange->{{-0.5,1.0},{-0.5,1.5}}]}]]

phaseLine1[x(1-x)]

Mindegy, mit adunk be neki, ugyanazt rajzolja.

phaseLine1[x(1-(x^2))]

Most három dolgot módosítunk: bevezetjüük a valódi változót rhsfunval néven, lokális változókat írunk a Module megfelelő listájába, és végül az x szám helyébe az x(t) függvényértéket írjuk.

x(1-x)/.{x->x[t]}

phaseLine2[rhsfunval_]:=Module[{pnds,pl2,rhs,plr,sp,ph},pnds=ParametricNDSolve[{x'[t]== (rhsfunval/.{x->x[t]}),x[0]==x0},x,{t,-2,2},{x0}];
pl2=Plot[Evaluate[Table[x[x0][t] /. pnds, {x0, -.1, 1.1, .2}]], {t, 0,2}, PlotRange -> {-2,2},AspectRatio->GoldenRatio,PlotStyle->Directive[Thickness[0.01]]];
rhs=ParametricPlot[{-rhsfunval,x},{x,-.2,1.2},PlotStyle->Directive[Red,Thick]];
plr=Show[rhs,pl2,PlotRange->{-0.5,1.2}];
sp=StreamPlot[{1,rhsfunval},{t,-1,1},{x,-2,2}];
ph=Graphics[{Thick,Line[{{0,-2},{0,2}}],PointSize[Large],Point[{0,0}],Point[{0,1}]}];
GraphicsColumn[{GraphicsRow[{sp,plr,ph}],
Show[sp,plr,ph,PlotRange->{{-0.5,1.0},{-0.5,1.5}}]}]]

phaseLine2[x(1-x)]

phaseLine2[x(1-(x^2))]

Jó lenne a stacionárius pontokat automatikusan megkapni.

sol=Solve[x(1-x)==0,Reals]

x/.sol

... és lerajzolni.

Point[{0,#}]&/@(x/.sol)

Prepend[Point[{0,#}]&/@(x/.sol),PointSize[Large]]

Graphics[{Thick,Line[{{0,-2},{0,2}}],PointSize[Large],Point[{0,0}],Point[{0,1}]}]

Join[{Thick,Line[{{0,-2},{0,2}}]},Prepend[Point[{0,#}]&/@(x/.sol),PointSize[Large]]]

Graphics[Join[{Thick,Line[{{0,-2},{0,2}}]},Prepend[Point[{0,#}]&/@(x/.sol),PointSize[Large]]]]

Automatikusan határozzuk meg az egyenesszakasz két végpontját is.

phaseLine3[rhsfunval_]:=Module[{pnds,pl2,rhs,plr,sp,ph},pnds=ParametricNDSolve[{x'[t]== (rhsfunval/.{x->x[t]}),x[0]==x0},x,{t,-2,2},{x0}];
pl2=Plot[Evaluate[Table[x[x0][t] /. pnds, {x0, -.1, 1.1, .2}]], {t, 0,2}, PlotRange -> {-2,2},AspectRatio->GoldenRatio,PlotStyle->Directive[Thickness[0.01]]];
rhs=ParametricPlot[{-rhsfunval,x},{x,-2,2},PlotStyle->Directive[Red,Thick]];
plr=Show[rhs,pl2,PlotRange->{-0.5,1.2}];
sp=StreamPlot[{1,rhsfunval},{t,-2,2},{x,-2,2}];
sol=Solve[rhsfunval==0,x,Reals];from=Min[x/.sol];to=Max[x/.sol];
ph=Graphics[Join[{Thick,Line[{{0,from-1},{0,to+1}}]},Prepend[Point[{0,#}]&/@(x/.sol),PointSize[Large]]]];
GraphicsColumn[{GraphicsRow[{sp,plr,ph}],
Show[sp,plr,ph,PlotRange->{{-2,2},{-2,1.5}}]}]]

phaseLine3[x(1-x)]

phaseLine3[x(1-(x^2))]

phaseLine3[x]

phaseLine3[-x]

phaseLine3[0 x]

Itt még többször szerepel from és to, tehát több dolog illeszkedik automatikusan a megoldandó feladathoz.

phaseLine4[rhsfunval_]:=Module[{pnds,pl2,rhs,plr,sp,ph,from,to,sol},pnds=ParametricNDSolve[{x'[t]== (rhsfunval/.{x->x[t]}),x[0]==x0},x,{t,-2,2},{x0}];
pl2=Plot[Evaluate[Table[x[x0][t] /. pnds, {x0, -.1, 1.1, .2}]], {t, 0,2}, PlotRange -> {-2,2},AspectRatio->GoldenRatio,PlotStyle->Directive[Thickness[0.01]]];
rhs=ParametricPlot[{-rhsfunval,x},{x,-2,2},PlotStyle->Directive[Red,Thick]];
plr=Show[rhs,pl2,PlotRange->{-0.5,1.2}];
sol=Solve[rhsfunval==0,x,Reals];
from=Min[x/.sol];to=Max[x/.sol];
sp=StreamPlot[{1,rhsfunval},{t,-2,2},{x,from-1,to+1}];
ph=Graphics[Join[{Thick,Line[{{0,from-1},{0,to+1}}]},Prepend[Point[{0,#}]&/@(x/.sol),PointSize[Large]]]];
Column[{GraphicsRow[{sp,plr,ph}],Show[sp,plr,ph,PlotRange->{{from-1,to+1},{from-1,to+1}}]}]]

phaseLine4[x(1-x)]

phaseLine4[x(1-(x^2))]

phaseLine4[x(1-x)(x+2)]

3. HF.: Alkalmazzuk minél többre, hogy kiderüljenek a hibái. Fejlesszük, ami nem jó benne. (Kétváltozós rendszerek?)

Példul az alábbiakra az a paraméter rögzített értéke mellett.

(Subscript[f, 1])[a_,x_]:=(x^2)-a x

(Subscript[f, 2])[a_,x_]:=(x^3)-a x

f[a_,x_]:=(x^3)- x+a

f[a_,x_]:=a x+Sin[x] (a∈[-1,1])

Bifurkáció (egyszerű példák)

Hogyan függ a hosszútávú viselkedés a paraméterektől?

x'[t]==k x[t]

Ha k=0, minőségi változás következik be: bifurkáció.

rhsfun=(x^2)(a-x);

s=Solve[rhsfun==0,x]

Evaluate[x/.s]

Plot[Evaluate[x/.s],{a,-2,2},PlotStyle->{Thickness[0.01],Red,Thickness[0.01],Blue,Thickness[0.01],Brown},AxesLabel->{a,(SubStar[x])},LabelStyle->Directive[{Large,Bold}] ]

bif[rhsfun_]:=Module[{s},s=Solve[rhsfun==0,x];Plot[Evaluate[x/.s],{a,-2,2},PlotStyle->{Thickness[0.01],Red,Thickness[0.01],Blue,Thickness[0.01],Brown},AxesLabel->{a,(SubStar[x])},LabelStyle->Directive[{Large,Bold}] ]]

bif[(x^2)(a-x)]

bif[ x(1-x)-a]

bif[(x^2)-a x]

(Subscript[f, 2])[a_,x_]:=(x^3)-a x

f[a_,x_]:=(x^3)- x+a

f[a_,x_]:=a x+Sin[x] (a∈[-1,1])

4. HF.: Tekintsük ezt: f(a,b,x):=a x-(x^3)-b. Bifurkációs görbék: f(1,b,x),f(0,b,x),f(-1,b,x). Többi a esetén?

A többi szorgalmi:

Rögzítsük b értékét. Hogyan függ a-tól?

Derítsük fel az egész (a,b) síkot. Milyen bifurkációt tapasztalunk a határoló görbéknél?

M a helyzet a (0,0) pontban, ha a  (és esetleg b is) változik?

Külön a vegyészeknek:

Ugyanez a Schlögl-reakcióra: f(a,b,x):=1-a x+b (x^2)-(x^3) (Hogyan jött ki a dimenziómentes alak? Mi az új paraméterek jelentése?)

Hyperlink["Brusselator","http://demonstrations.wolfram.com/HopfBifurcationInTheBrusselator/"]

Az alábbihoz kell a ReactionKinetics csomag:

Quit[];

SetDirectory[NotebookDirectory[]];

Needs["ReactionKinetics1`"];//AbsoluteTiming

sch=GetProblem["Schlögl"]

DetailedBalanced[sch,{(Subscript[k, 1]),(Subscript[k, -1]),(Subscript[k, 2]),(Subscript[k, -2])}]

Poincaré-leképezés

Numerikusan; szimbolikusan szinte sohasem megy.

NDSolve

nd[p_]:=NDSolve[{x'[t]==5x[t](1-x[t])-0.8(1+Sin[2π t]),x[0]==p},x,{t,0,1}][[1,1,2]];

nd[1]

nd[1][1]

poincare[p_]:=nd[p][1]

poincare[0.44]

Plot[{p,poincare[p]},{p,0.32,1.32},AxesOrigin->{0,0}]

FindRoot[p==poincare[p],{p,0.8}]

ParametricNDSolve

poi=ParametricNDSolve[{x'[t]==5x[t](1-x[t])-0.8(1+Sin[2π t]),x[0]==p},x,{t,0,1},{p}]

(x[1]/.poi)[1]

Plot[Evaluate[{p,(x[p]/.poi)[1]}],{p,0.32,1.32},GridLines->Automatic]

WhenEvent

ClearAll[nd2];nd2=ParametricNDSolveValue[{x'[t]==5x[t](1-x[t])-0.8(1+Sin[2π t]),x[0]==p,WhenEvent[t==1,{Sow[x[t]],"StopIntegrate"}]},x,{t,0,1},{p}];

Reap[nd2[0.45]]

ClearAll[nd3];nd3=ParametricNDSolveValue[{x'[t]==5x[t](1-x[t])-0.8(1+Sin[2π t]),x[0]==p,WhenEvent[t==1,{Sow[x[t]],"StopIntegrate"}]},x,{t,0,1},{p},Method->{"ParametricCaching"->None}];

Reap[nd3[0.45]]

poinc[p_]:=First@First@Last@Reap[nd3[p]]

poinc[0.45]

A WhenEvent - be bonyolultabbat is írhatok.

Plot[{p,poinc[p]},{p,0.32,1.32}]

Még másik

poi2[p_]=x[p]/.poi

poi3[p_]=poi2[p][1]

Plot[Evaluate[poi3[p]],{p,0.32,1.32}]

Fixpontok

Plot[{Evaluate[poi3[p]],p},{p,0.32,1.32}]

NestList[poi3,1,4]

NestList[poi3,.41,4]

NestList[poi3,.31,4]

FixedPointList[poi3,1]

Milyen (SuperStar[h]) esetén létezik egyetlen fixpontja a Poincaré leképezésnek?

pnds=ParametricNDSolve[{x'[t]==5x[t](1-x[t])-h(1+Sin[2π t]),x[0]==p},x,{t,0,1},{p,h}]

y17=x[1,0.7]/.pnds

y17[1]

poincare[p_,h_]:=(x[p,h]/.pnds)[1]

poincare[1,0.7]

Manipulate[Plot[{p,poincare[p,h]},{p,0.32,1.32},AxesOrigin->{0,0}],{h,1.14,1.20,0.01}]

Manipulate[Plot[{p,poincare[p,h]},{p,0.32,1.32},AxesOrigin->{0,0}],{h,1.,1.30,0.01}]

5. HF.: Keressenek ilyesmit a demonstrations.wolfram.com honlapon, és röviden ismertessenek egy-egyet közülük:

demo : poincaré map -disk

demo : bifurcation