Nagy házikhoz

Wavelet

ψ[x_]:=Piecewise[{{1,0≤x<(1/2)},{-1,1/2<x≤1}}]

ψ[j_Integer,k_Integer,x_]:=ψ[(2^j) x-k]

Manipulate[
If[k>(2^j)-1,k=(2^j)-1];
Plot[ψ[j,k,x],{x,-0.05,1.05},
Exclusions->None,
Filling->Axis,
AxesLabel->{Style["x",Italic]},
PlotLabel->(Subscript[ψ, j,k])[x],
ImageSize->{500,350},
ImagePadding->{{10,20},{10,10}}],
{{j,0,Style["j",Italic]},Range[0,4],SetterBar},
{{k,0,Style["k",Italic]},Range[0,2^j-1],SetterBar},
SaveDefinitions->True,AutorunSequencing->{1}]

Rademacher függvények?

Hangszerek fizikája

Normal Modes of a Circular Drum Head

Az órán azért nem ment, mert ϑ csak néhol volt átjavítva.

Manipulate[
Module[{nthzero},
nthzero=N[BesselJZero[n,kthroot]];ParametricPlot3D[Evaluate@{s Cos[ϑ],s Sin[ϑ],Cos[time] Cos[n ϑ] BesselJ[n,s nthzero]},{s,0,1},{ϑ,0,2 π},PlotRange->1,Mesh->mesh,Boxed->True,Axes->False,SphericalRegion->True,ImageSize->{375,375}]],
{{mesh,False,"show mesh"},{False,True},ControlType->Checkbox},
{{n,0,"order n"},0,5,1,RadioButton},
{{kthroot,1,"(k^th) zero"},1,4,1,RadioButton},
{{time,0,"time"},0, 2 π}
]

Poincaré, nemlineáris

Ennél csináljon jobbat, akit érdekel.

nds=NDSolve[{x'[t]==y[t],y'[t]==-x[t]-0.1((y[t])^2),x[0]==1,y[0]==0},{x,y},{t,0,1100}]

ParametricPlot[Evaluate[{x[t],y[t]}/.nds],{t,0,6}]

Plot[Evaluate[{x[t],y[t]}/.nds],{t,0,6.2}]

FindRoot[(y[t]/.nds)==0,{t,6}]

fr=FindRoot[(y[t]/.nds)==0,{t,#}]&/@(2π Range[100])//Quiet

fl=Flatten[{x[t],y[t]}/.nds/.fr,1]

xek=First/@fl

aaa={c,v,b,n,m}

Partition[aaa,2,1]

Graphics[Point/@Partition[xek,2,1],Axes->True,AxesLabel->{(Subscript[x, n]),(Subscript[x, n+1])}]

Reap/Sow, Catch /Throw

Biológiai jelek feldolgozása

data={{-1.1,2.6},{3.9,-0.8},{4.2,-3.7},{3.3,3.5},{3.9,5.2},{4.1,-4.8},{3.8,3.7},{5.6,0.1},{3.1,-5.2},{-0.9,2.3},{2.9,4.1},{-2.3,3.9},{-2.5,3.},{2.6,-5.5},{5.2,1.9},{-0.7,1.3},{0.9,2.8},{-1.5,3.3},{3.8,1.2},{2.6,-5.1},{-0.8,3.2},{4.7,0.7},{3.,3.},{3.9,3.6},{4.5,1.4},{4.2,1.3},{-1.1,2.6},{4.8,2.4},{3.3,-3.5},{3.2,-4.6},{3.3,-4.9},{3.,3.5},{0.7,2.1},{3.2,-4.3},{-2.,0.5},{-1.2,2.},{-1.6,1.8},{-3.5,3.7},{4.8,0.2},{3.3,2.4},{-0.1,2.1},{-1.3,2.5},{4.4,3.9},{3.5,0.2},{0.1,2.9},{-1.,1.6},{-1.4,4.5},{3.2,2.5},{-1.6,2.4},{2.6,-5.1}};

Grid[Partition[ListPlot[FindClusters[data,#],PlotLabel->#]&/@Range[2,5],2]]

gdata={"GTCTT","AAGCT","GGTAA","AGGCT","GTCAT","CGGCC","GGGAG","GTTAT","GTCAT","AGGCT","GTCAG","AGGAT"};

FindClusters[gdata,DistanceFunction->HammingDistance]

HammingDistance[u,v] gives the number of elements whose values disagree in u and v.

GaussianRandomData[n_Integer,p_,sigma_]:=Table[p+{Re[#],Im[#]}&[RandomReal[NormalDistribution[0,sigma]](E^(I RandomReal[{0,2π}]))],{n}];
datapairs=BlockRandom[
SeedRandom[1234];
Join[GaussianRandomData[100,{2,1},.3],GaussianRandomData[100,{1,1.5},.2],
GaussianRandomData[100,{1,1.1},.4],GaussianRandomData[100,{1.75,1.75},0.1]]];

Grid[Partition[ListPlot[FindClusters[datapairs,#],PlotLabel->#]&/@Range[2,5],2]]

Enzimkinetika

enzim=NDSolve[{e'[t]==-(Subscript[k, 1])e[t]s[t]+(Subscript[k, -1])c[t]+(Subscript[k, 2])c[t],s'[t]==-(Subscript[k, 1])e[t]s[t]+(Subscript[k, -1])c[t],c'[t]==(Subscript[k, 1])e[t]s[t]-(Subscript[k, -1])c[t]-(Subscript[k, 2])c[t],p'[t]==(Subscript[k, 2])c[t],e[0]==0.1,s[0]==0.2,c[0]==0,p[0]==0}/.{(Subscript[k, 1])->100,(Subscript[k, -1])->200,(Subscript[k, 2])->2},{e,s,c,p},{t,0,300}]

Plot[Tooltip[Evaluate[{e[t],s[t],c[t],p[t]}/.enzim]],{t,0,0.05}]

Plot[Tooltip[Evaluate[{c[t],p[t]}/.enzim]],{t,0,0.5}]

Plot[Tooltip[Evaluate[{c[t]}/.enzim]],{t,0,0.5}]

Plot[Tooltip[Evaluate[{c[t]}/.enzim]],{t,0,50},PlotLabel->"A vége konvex vagy konkáv?"]

Az utosló kérdés matematikusnak is érdekes!

Funkcionális programozás, folytatás

Listák fokozatos fölépítése

Nem AppendTo

Nem ez

ize[n_]:={Factorial[n],{Factorial[Range[0,n]]}}

ize[8]

Hanem ez

izeke[n_]:=Block[{blbl={}},Nest[{#[[1]](#[[2]]+1),#[[2]]+1,AppendTo[blbl,#[[1]](#[[2]]+1)]}&,{1,0,blbl},n]][[{1,3}]]

izeke[8]

Timing[izeke[1000];]

AppendTo lassú. Mondja, de nem látom. Inkább: Reap/Sow

factorialList[n_Integer/;n≥0]:=Reap[factorialListSow[n]];
factorialListSow[0]:=Sow[1];
factorialListSow[n_]:=Module[{fact},Sow[n factorialListSow[n-1]]]

factorialList[8]

Timing[factorialList[1000];]

Na, puff. Megismételhető, ez után:

$RecursionLimit=4096

Reap és Sow numerikus algoritmusok követésére

Reap: létrehoz egy privát sort. Sow: a sor végére tesz egy kifejezést.
Amikor kilépünk a Reap-ből, visszakapjuk a sort, meg amit a Reap-ben kiszámoltunk.

Module[{x,y,f=Function[{x,y},((((x^3)-(y^2)))^2)]},Reap[NMinimize[f[x,y],{{x,-5,5},{y,-5,5}},EvaluationMonitor:> Sow[{x,y}]]]]

De:Monitor is van.

A Nest család

Szeretjük a gyakori tőkésítést és az E számot.

kamatoskamat[toke_,kamatlab_,evek_,n_]:=Nest[#(1+(kamatlab/n))&,toke,n evek]

Table[kamatoskamat[1000,0.05,10,n],{n,{1,2,4,12,365}}]

TableForm[Table[kamatoskamat[1000,0.05,10,n],{n,{1,2,4,12,365}}],TableHeadings->{{1,2,4,12,365},None}]

Koch-féle hópehely

Graphics[Line[{{0,0},{1,2},{2,1}}]]

ScalingMatrix[{(1/3),(1/3)}]

ScalingMatrix[{(1/3),(1/3)}].{a,b}

RotationMatrix[(π/3)]

RotationMatrix[(π/3)].{{0,0},{1,0}}

Dot[RotationMatrix[(π/3)],#]&/@{{0,0},{1,0}}

Graphics[{PointSize[Large],Point[{0,0}],Arrow[{{0,0},{1,0}}],Red,Arrow[Dot[RotationMatrix[(π/3)],#]&/@{{0,0},{1,0}}],Circle[{0,0},(1/4),{0,(π/3)}],Text[Style["α",Large,Bold,Red],{0.14,0.075}]}]

ClearAll[koch,snowflake];
koch[Line[x_]]:=With[{s=ScalingMatrix[{(1/3),(1/3)}],r1=RotationMatrix[(π/3)],r2=RotationMatrix[-(π/3)]},
{Line[x.s],
Line[x.r1.s+{{(1/3),0},{(1/3),0}}],
Line[x.r2.s+{{(1/2),-0.289},{(1/2),-0.289}}],
Line[s.x+{{(2/3),0},{(2/3),0}}]}];
snowflake[n_]:=With[{g=Graphics[{Line[{{0,0},{1,0}}]}]},Nest[#/.Line[x_]:> koch[Line[x]]&,g,n]]

GraphicsGrid[{{snowflake[1],snowflake[3]},{snowflake[2],snowflake[4]}}]

NestList mutatja a részleteket.

Új házi feladatok

1. Négy horgász indul a tóhoz, mindegyikük egy-egy horgászbotot visz magával. Útközben elhatározzák, hogy kipróbálják egymás horgászbotját. Amint a tóhoz értek, mindannyian le is cserélték pecabotjukat valamelyik másikra. Hányféleképpen tudták ezt megtenni? (Nézegessük a Combinatorica csomagot.)

2. Írjuk meg az Euler-módszer programját Nest, NestWhile stb. felhasználásával. (Például: felezzük a lépésközt, és akkor álljunk meg, amikor az utolsó két közelítés eltérése kisebb, mint ε.)

Microscope,ComputerArithmetic/tutorial/ComputerArithmetic

3. Írjuk meg a fokozatos közelítés módszerét differenciálegyenletek megoldására szimbolikusan és numerikusan is.