SetDirectory[NotebookDirectory[]]

A házi feladatok megoldása

1. Az előző órán tanult becslési módszerek bármelyikét alkalmazzák olyan adatokra, amelyek 1, vagy saját mérésből 2, vagy a hálóról 3. vagy a Mathematica ?*Data adataiból származik.

Király Márton

ClearAll[A];
A[φ_]:=(((1+1/φ))^φ)
nl=NestList[A , 1,10];

ListPlot[nl]

DiscretePlot[Evaluate[((N[nl])^x)],{x,0,4},PlotLegends->Automatic]

Plot[Evaluate[{(E^x), ((nl[[19]])^x)}],{x,0,4},PlotStyle->{Red, Green,Blue}]

Oláh Judit

Illesztés

Két fehérje kölcsönhatása ELISA méréssel, amikor az egyik fehérje lemezre van kötve, a másik fehérjét különböző koncentrációban adjuk az első fehérjéhez, és a kötődött fehérjét specifikus ellenanyaggal detektáljuk. 1:1 arányú komplex kialakulása esetén a kapott telítési görbe hiberbolával illeszthető

y = Amax * X /(Kd + X),
ahol y a mért érték, Amax a maximális érték, x a fehérje koncentrációja,míg Kd a kölcsönhatásra jellemző disszociációs állandó.

Read,OpenWrite

measureddata=Import[NotebookDirectory[]<>"data1_OlahJ.txt", "Table"]
ListPlot[measureddata,PlotRange->{0,1.1},PlotStyle->{PointSize[Large]}]

Clear[fit]
fit=NonlinearModelFit[measureddata,Amax (x/(Kd + x)) ,{ Amax,Kd},x];

fit["ParameterTable"]

σ=Last[fit["ParameterErrors"]]

Plot[{fit["BestFit"]},{x,0,5},PlotRange->{0,1.5},Epilog->{PointSize[Medium],Red,Point[measureddata]}]

ListPlot[fit["FitResiduals"]]

Orosz Dávid

Az adatok egy általam végzett mérésből származnak. A mérés célja az induktív útadó karakterisztikájának meghatározása, hitelesítése volt.

SetDirectory[NotebookDirectory[]];

fesz=Import["feszultseg.txt","List"];

elm=Import["elmozdulas.txt","List"];

data=Table[{elm[[i]],fesz[[i]]},{i,1,50}];

Transpose[{elm,fesz}]==data

fit=LinearModelFit[data,x,x]

nlfit=NonlinearModelFit[data,a x+b,{a,b},x]

Plot[fit[x],{x,-2,2},Epilog->{PointSize[Small],Orange,Point[data]},ImageSize->800]

Mi van az elejével? Miért nem nemlineáris?

2. Keressenek a hálón Mathematica egysorosokat (oneliner), és próbálják megérteni a működésüket.

Király Márton

Mathematica Experts Live 2012, Grand Prize Winner: Boris Faleichik, Minsk, Belarus

r:=.5-Random[];
p=Array[{(8^9){r,r},r+.5}&,99];
Dynamic@Graphics[
Disk@@@(p={#2 #1+{r,r}+(1-#2)MousePosition["Graphics",#1],#2}&@@@p),
PlotRange->44
]

r

RandomReal[{-0.5,0.5}]

Random ({{, As of Version 6.0, Random has been superseded by the functions RandomReal and RandomInteger.}})

MousePosition

{Graphics[Disk[],ImageSize->100],Dynamic[MousePosition["Graphics"]]}

{Graphics[Disk[],ImageSize->100],Dynamic[MousePosition["Graphics","Mouse not in graphics!"]]}

Oláh Judit

Mathematica one - liner

Stephan Leibbrandt' s elegant simulation of gravitational attraction, the First - Place winner of the One - Liner Competition. Animated output, simulation of a physical phenomenon, and clever use of a variable (d) to conserve characters impressed the judges. Stephan' s code reveals a deep familiarity with Mathematica 's programming constructs, which enabled him to pack a complete physics simulation into just 138 characters.

Dynamic[Refresh[Graphics3D[Sphere[
l -= MapIndexed[
Plus@@(Function[x,((d = # - x)/(d = (Sqrt[d.d]))) Log@d/(2^(2 + 2 d))]/@
Drop[l, #2])&,l],(E^(-1))]]],l=RandomReal[7, {15,3}]]

Function[x,((d = 1 - x)/(d = (Sqrt[d.d]))) Log@d/(2^(2 + 2 d))][a]

Plus@@Function[x,((d = 1 - x)/(d = (Sqrt[d.d]))) Log@d/(2^(2 + 2 d))][a]

l

MapIndexed

MapIndexed[f,{a,b,c,dd}]

MapIndexed[First[#2]+f[#1]&,{a,b,c,dd}]

MapIndexed[f,<|"a"->1,a->2, 1->1|>]

MapIndexed[Labeled,{x^2,x+y,y^2,y^3}]

MapIndexed[Framed[Labeled[#1,#2]]&,{x^2,x+y,y^2,y^3},Infinity]

MapIndexed[#1 x^First[#2]&,{a,b,c,dd,e}]

Total[MapIndexed[#1 x^First[#2]&,{a,b,c,dd,e}]]

MapIndexed[
Plus@@(Function[x,((d = # - x)/(d = (Sqrt[d.d]))) Log@d/(2^(2 + 2 d))]/@
Drop[l, #2])&,l]

Mester Dávid

Az általam válaszott one-liner, a 2010-es one-liner verseny győztese.
A kód véletlenszenrűen elhelyezett 21 darab gömb közötti gravitációs vonzás mutatja be. A mozgási egyenletek szimulálása helyett a program a Dynamic beépített függvényt tartalmazza amely a fizikai erők közelítését tartalmazza. Az 1-es lista tartalmazza a 21 gömb koordinátáját. A drop függvény biztosítja, hogy az egyes gömbök csak egymással hathassanak kölcsön. A feladat a d változó minimalizálása.

Dynamic[Refresh[Graphics3D[Sphere[l-=MapIndexed[Plus@@(Function[x,(d=#-x)/(d=Sqrt[d.d]) Log@d/2^(2+2 d)]/@Drop[l,#2])&,l],E^-1]],UpdateInterval->1],l=RandomReal[7,{21,3}]]

3. Mit tudnak közönséges differenciálegyenletek periodikus megoldásainak létezéséről? Ez lesz a téma legközelebb.

Mester Dávid

A kétdimenziós rendszerekben periodikus  megoldás létezését a Poincaré-Bendixson tétel segítsévégel, nem létezését pedig a Bendixson-Dulac kritériummal lehet igazolni. A rendszer differenciálegyenlet-renszer nullvonalainak vizsgálatát Ljapunov-függvény bevezetésével tudjuk elvégezni. A függvény bevezetése után a pályák viselkedésének meghatározásához a függvény előjelét kell meghatározni. Ha értelmezünk egy Poincaré-leképzést alkalmazunk. Igazolható, hogy ha a Poincaré-leképezés folytonos, akkor a leképezés az adott intervallumot önmagába képezi folyamatosan, és van fixpontja. Ez a pont a rendszer periodikus pontja, hiszen a belőle induló pálya önmagába tér vissza.

Stacionárius pontok

Létezés

Néha nincs:

x´[t]==1

Egyértelműség

Néha több van:

x´[t]==1-((x[t])^2)

Pozitivitás

De lehet, hogy a változók jelentése miatt csak a pozitív a megfelelő nekünk.

Solve[{1-(x^2)==0,x>0},x]

Előállítás

A hatvanas évek nagy felfedezése (Buchberger) szerint polinomiális algebrai rendszerek épp úgy háromszögalakúra hozhatók, mint a lineáris rendszerek.

GroebnerBasis

Stabilitás

Lineáris rendszereknél: sajátértékek

Nemlineáris rendszereknél

Linearizálás

A durva esetek kezelhetők.

Ljapunov-függvények

De milyen alakban keressük őket?

Periodikus megoldások

A létezés elégséges feltételei

Bendixson-zsák

Hopf-bifurkáció

Manipulate[Module[{nds,x,y},nds=NDSolve[{x'[t]==1+a ((x[t])^2)y[t]-(b+1)x[t],y'[t]==a(b x[t]-a ((x[t])^2)y[t]),x[0]==8,y[0]==3},{x,y},{t,0,100}][[1]];
ParametricPlot3D[Evaluate[{{90,x[t],y[t]},{t,x[t],0},{t,4,y[t]}}/.nds],{t,90,100},BoxRatios->{1,1,1},PlotPoints->100,PlotRange->{{90,100},{0,4},{0,8}},AxesLabel->{Style["t",Italic],Row[{Style["x",Italic],"(",Style["t",Italic],")"}],Row[{Style["y",Italic],"(",Style["t",Italic],")"}]}, PlotStyle->Directive[Thick,RGBColor[.49,0,0]],ImageSize->{400,400},PlotLabel->"Trajectory and coordinate functions of the solutions\n\n"]],
{a,1.9,2.03,0.001,Appearance->"Labeled"},
{b,4.8,6.0,0.001,Appearance->"Labeled"}]

A Poincaré-leképezés fix pontja

A létezés szükséges feltételei

Monotonitás

Bedixson-tétel

Bendixson-Dulac-tétel

Póta-Hanusse-Tyson-Light

Oligooszcilláció, tranziens jelenségek

(Irányítás) A súgó alábbi példáját tanulmányozva

nds=NDSolve[{x''[t] + x[t]==0,x'[0]==π,x[0]==0, WhenEvent[{x[t]==2,x[t]==-3},x'[t]->-x'[t]]},x,{t,0,20}];
Plot[{x[t]/.nds,2,-3},{t,0,20}]

modellezzük egy szoba fűtését: amikor a hőmérséklet eléri a 22 fokot, a fűtés kikapcsol, és a levegő a Newton-féle lehűlési törvény szerint hűl. Amint eléri a 18 fokot, bekapcsolunk egy 40 fokos kályhát. Rajzoljunk le 4  periódust.

nd=First@NDSolve[{D[T'[t]==-(T[t]-18),t],T[0]==21,T'[0]==18-T[0],WhenEvent[{T[t]==18.01},T'[t]->24-T[t]],WhenEvent[{T[t]==21.99},T'[t]->18-T[t]]},T,{t,0,30}]

Plot[T[t]/.nd,{t,0,30}]

Házi feladatok

1. Határozzuk meg az origó stabilitását az x'[t]=A x[t] rendszerek esetén, ahol

A = {{2,5}, {-3,3}}

A = {{2,-5}, {-3,3}}

A = {{-2,-5}, {-3,-3}}

A = {{2,1}, {0,2}}

Használjuk ezeket a függvényeket.

StreamPlot, Eigenvalues, Eigenvectors, Eigensystem

2. Készítsük el az iránymezőt a StreamPlot függvény alkalmazásával a következő rendszerek esetére:

x'[t]=y[t]     y'[t]=-x[t]

x'[t]=y[t] -((x[t])^2)    y'[t]=-x[t]-((y[t])^2)

x'[t]=y[t] +((x[t])^2)    y'[t]=-x[t]+((y[t])^2)

3. Írjunk programot annak eldöntésére, hogy egy autonóm, közönséges differenciálegyenlet-rendszernek egy megadott függvény első integrálja-e. Alkalmazzuk  a harminukus oszcillátor és az összenergia (helyzeti és mozgási) esetére.