Programozási tudnivalók

1. Saját csomag készítése

Első menet

File|New|Package

BeginPackage["square`"];
square::usage="square[x] gives x^2";
square[x_]:=x^2;
EndPackage[]

?square

Needs["square`"]

SetDirectory[NotebookDirectory[]]

Needs["TJCsomag`"]

<<TJCsomag`

?square

Get["TJCsomag`"]

square[2]

Bonyolítjuk

Kontextus:elérési út

BeginPackage["sq`"];
sq::usage="sq[x] gives x^2";
Begin["`Private`"]
sq[x_]:=x^2;
End[](*Visszatérübnk az előző kontextushoz*)
EndPackage[]

sq[2]

?sq

sq[x_]:=x

?sq

sq[d]

Konkrét példa

BeginPackage["Collatz`"]

Collatz::usage =
        "Collatz[n] gives a list of the iterates in the 3n+1 problem,
        starting from n. The conjecture is that this sequence always
        terminates."
Begin["`Private`"]
Collatz[1] := {1}
Collatz[n_Integer]  := Prepend[Collatz[3 n + 1], n] /; OddQ[n] && n > 0
Collatz[n_Integer] := Prepend[Collatz[n/2], n] /; EvenQ[n] && n > 0
End[ ]
EndPackage[ ]

<<ExampleData/Collatz.m

$ContextPath(*Itt keres*)

Context[Collatz]

?Collatz`Private`*

Távoli elérés, teljes név

$Packages

Használunk mást is

BeginPackage["square`","Music`"];
Unprotect[square];
square::usage="square[x] gives x^2";
Begin["`Private`"]
square[x_]:={x^2,msc};
msc=MusicScale[JustMajor,440,3];
Protect[square];
End[](*Visszatérübnk az előző kontextushoz*)
EndPackage[]

square[2]

<<Benchmarking`

Benchmark[]

<<Music`

MusicScale[JustMajor,440,3]

<<TJCsomag2`

square[3]

Hyperlink["Foolproof","paclet:guide/PackageBulletproofing"]

Message

Message[ff::argx,1,2]

rsqrt[x_]/;If[TrueQ[x≥0],True,Message[rsqrt::nnarg,x];False] :=Sqrt[x]

rsqrt::nnarg="The argument `1` is not greater than or equal to zero.";

rsqrt[2.25]

rsqrt[-2.25]

ReactionKinetics.m

Belenézünk

1. HF.: Készítsenek saját csomagot beletéve néhány korábbi függvényünket, és próbálják ki működését.

2. Modulok ellenőrzése

mm=Module[{x,y},x=Sin[(π/4)];Log[x];y=2;x+y]

{x=Sin[(π/4)],Log[x],y=2,x+y}

De már van erre kész eszköz:

Reap[Sow[a];b;Sow[c];Sow[d];e]

Reap[Sow[x=Sin[(π/4)]];Sow[Log[x]];Sow[y=2];x+y]

moduleControl[m_]:=??

g:=Module[{x,y},x=Sin[(π/4)];Log[x];y=2;x+y]

FullForm[g]

FullForm[Unevaluated[g]]

hg=HoldForm[g]

FullForm[HoldForm[g]]

Másik modul

successiveApproximation[f_,ξ_,η_,n_:2,z_:x]:=
Module[{A,φ,χ},A[φ_]:=Simplify[(η+(∫_ξ^(#))f[χ,φ[χ]]\[DifferentialD]χ)&];Through[NestList[A,η&,n][z]]]

successiveApproximation[λ#2&,0,1,5,z]

NestList[fff,x0,3]

ClearAll[f,λ,ξ,η,A,φ];
{f=λ #2&,ξ=0,η=1,A[φ_]:=Simplify[(∫_ξ^(#))f[χ,φ[χ]]\[DifferentialD]χ&],A[φ][t],n=3,Through[NestList[A,η&,n][z]]}

A[φ]

ClearAll[f,λ,ξ,η,A,φ];
Reap[Sow[f=λ #2&];Sow[ξ=0];Sow[η=1];A[φ_]:=Simplify[(∫_ξ^(#))f[χ,φ[χ]]\[DifferentialD]χ&];Sow[A[φ][t]];Sow[n=3];Sow[Through[NestList[A,η&,n][z]]]]

2. HF.: Alkalmazzák a fenti módszert saját korábban írott Module-juk ellenőrzésére.

3. Opciókról

Bevezetés, elkódorgás (detour)

SetOptions[#,AxesStyle->Arrowheads[Automatic]]&/@{Plot,ListPlot};

Plot[Sinc[x],{x,-π,2π},PlotStyle->Thickness[0.015],ColorFunction->Function[{x,y},RGBColor[y,y/2,y/4]]]

Animate[Graphics[{Arrowheads[{{.1,t},{.1,Mod[t+1/3,1]},{.1,Mod[t+2/3,1]}}],Thick,Arrow[{{0,0},{10,5}}]},PlotRangePadding->1],{t,0,1},AnimationRunning->False]

Plot[(t-0.5)(t-3),{t,0.5,3}]

Animate[Graphics3D[Sphere[],ViewPoint->{0,2+(t-1)(t-3),0},Boxed->False],{t,1,3},AnimationRunning->False,AnimationRepetitions->1]

lena=Import["ExampleData/lena.tif"];

Manipulate[Show[lena,ImageSize->200(t^2)],{t,0.5,2}]

3. HF.: Készítsenek animációs filmecskét!

Saját függvények opcióval

Options[ff]={SzepNapomVan->True};
ff[x_,opts___]:=If[SzepNapomVan/.{opts}/.Options[ff],(x^2),-1]

ff[2]

ff[2,SzepNapomVan->True]

ff[2,SzepNapomVan->False]

Absztraktabb példa

Options[fff]={a->1,b->2};

ClearAll[x];fff[OptionsPattern[]]:= {OptionValue[a],OptionValue[b]}

{fff[x],fff[],fff[a->17],fff[b->18],fff[a->17,b->18],fff[a->17,b->18,a->22]}

4. HF.: Egészítsék ki valamelyik saját függvényüket legalább két opcióval.

FilterRules

Hogy ne kutyulódjanak össze az opciók. Másképp: Meg lehet adni opcionális változókból két készletet?

FilterRules[{a-> 1,b-> 2,c-> 3},{b,a}]

FilterRules[{PlotRange->3,MaxIterations->5},Options[Plot]]

ClearAll[x,y,de];
odeplot[de_, y_, {x_, x0_, x1_}, opts:OptionsPattern[]] := 
Module[{sol},
sol = NDSolve[de, y, {x,x0,x1}, FilterRules[{opts}, Options[NDSolve]]];
If[Head[sol] === NDSolve,
$Failed,
Plot[Evaluate[y /. sol],{x,x0,x1}, Evaluate[FilterRules[{opts}, Options[Plot]]]]
]
]

odeplot[{y''[x] + y[x] == 0, y[0] == 1, y'[0] == 0}, y[x], {x,0,10}]

odeplot[{y''[x] + y[x] == 0, y[0] == 1, y'[0] == 0}, y[x], {x,0,10}, Method->"ExplicitRungeKutta", PlotStyle->Red]

Az időmérés problémája

TableForm[timings=Transpose[{Range[100, 500,25],Timing[Eigenvalues[RandomReal[1,{#,#}]]][[1]]&/@Range[100, 500,25]}],TableHeadings->{{},{n,Timing }}]

lp=ListPlot[timings,LabelStyle->{FontFamily->"Helvetica-Bold",FontSize->14},PlotLabel->"Timings\n as a function of size\n",Background->CMYKColor[0,0.1,0.5,0.1],PlotStyle->{PointSize[0.03],RGBColor[0,0,1]},PlotRange->{{50,550},{0,2.2}},Ticks->{Automatic,{0.5,1,1.5,2}},GridLines->{Automatic,Automatic},AxesOrigin->{50,0},AxesLabel->{Style["size",{"Courier-Bold",10}],"time needed"},PlotRegion->{{0.1,0.9},{0.1,0.9}},ImageSize->{400,300}]

ops={LabelStyle->{FontFamily->"Helvetica-Bold",FontSize->14},PlotLabel->"Timings\n as a function of size\n",Background->CMYKColor[0,0.1,0.5,0.1],PlotStyle->{PointSize[0.03],RGBColor[0,0,1]},PlotRange->All,Ticks->{Automatic,{0.5,1,1.5}},GridLines->{Automatic,Automatic},AxesOrigin->{50,0},AxesLabel->{Style["size",{"Courier-Bold",10}],"time needed"},PlotRegion->{{0.1,0.9},{0.1,0.9}},ImageSize->{500,300}};

opser=FoldList[Append,{},ops];

FoldList[Append,{},{aa,s,dd,ff,gg}]

Accumulate

clp=Column[ListPlot[timings,#]&/@opser]

Miért nem látszik a függőleges tengelyen az 1.5-es jelzés?

Táblázat a hatásokról

opsnolinefeed={LabelStyle->{FontFamily->"Helvetica-Bold",FontSize->14},PlotLabel->"Timings as a function of size",Background->CMYKColor[0,0.1,0.5,0.1],PlotStyle->{PointSize[0.03],RGBColor[0,0,1]},PlotRange->{{50,550},{0,0.4}},Ticks->{Automatic,{0.5,1,1.5,2}},GridLines->{Automatic,Automatic},AxesOrigin->{50,0},AxesLabel->{HoldForm[Style["size",{"Courier-Bold",10}]],"time needed"},PlotRegion->{{0.1,0.9},{0.1,0.9}},ImageSize->{400,300}};

TableForm[Transpose[{opsnolinefeed,{"sets labelstyle","labels the plot","colors the bg","emphasizes points","sets plotrange","changes ticks","draws gridlines","shifts axesorigin","labels the axes","reduces figure","enlarges plot"}}],TableHeadings->{{},{OPTION,EFFECT}},TableSpacing->{1,1}]

5. HF.: Hogyan érhető el, hogy a size szöveg ne 10 pontos betűvel jelenjen meg? (Én még nem tudom a választ, amint az alábbiakból kiderül.)

Unevaluated[Style["size",{"Courier-Bold",10}]]

HoldForm[Style["size",{"Courier-Bold",10}]]

Összeszedve

optionProgress[f_,opts__]:=Module[{optsser=FoldList[Append,{},opts]},Map[f,optsser]]

optionProgress[ListPlot[timings,#]&,ops]

Egy másik alkalmazás

optionProgress[NIntegrate[(E^(-(x^2))),{x,-500,500},#]&,{MinRecursion->2,MaxRecursion->3}]

optionProgress[NIntegrate[(E^(-(x^2))),{x,-500,500},#]&,{MinRecursion->2,MaxRecursion->3}]-Integrate[(E^(-(x^2))),{x,-500,500}]

Vissza az idpőméréshez

ClearAll[a,b,t];nlm=NonlinearModelFit[timings,a (E^(b t)),{{a,1/4000,1/1000},{b,1/2000,1/100}},{t}]

Show[lp,Plot[nlm[t],{t,50,550},PlotStyle->{RGBColor[1,0,0.2],Thickness[0.015]}]]

nlm[600]

nlm[1000]

Még egy példa FoldList alkalmazására

ClearAll[eq1,eq2,x,y];
eq1=y[x]==(E^(C x));

D[eq1,x]

Eliminate[{eq1,D[eq1,x]},C]

gorbesereg1[eq_,par_]:=Simplify@Eliminate[{eq,D[eq,x]},par]

gorbesereg1[y[x]==(E^(C x)),C]//Quiet

Quiet??

eq2=y[x]==a (x^2)+b (E^x);

Eliminate[{eq2,D[eq2,x],D[eq2,{x,2}]},{a,b}]//Simplify

gorbesereg2[eq_,par_]:=Simplify@Eliminate[{eq,D[eq,x],D[eq,{x,2}]},par]

gorbesereg2[y[x]==a (x^2)+b (E^x),{a,b}]

curvefamilyODE[indep_,eq_,params_]:=Module[{},Eliminate[FoldList[D[#1,indep]&,eq,params],params]]

curvefamilyODE[x,eq1,{C}]

curvefamilyODE[x,eq2,{a,b}]

curvefamilyODE[x, y[x]==C x-C-C (x^2),{C}]

De a könyvben:

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

4. Egyszerűsítések

Azonosságot bizonyítunk

Megegyeznek minden valós x mellett?

ex1=1+Cosh[x];ex2=(Sqrt[2])Cosh[(x/2)](Sqrt[1+Cosh[x]]);

ex1==ex2

ex1-ex2

funs={TrigToExp,TrigFactor,PowerExpand,Simplify,PowerExpand};

expr=ex1-ex2;

funlists=FoldList[Append,{},funs]

fl=Reverse/@Rest@funlists

comp=Composition@@@fl

Through[comp[expr]]

HF. Válogassuk ki az összes lehetséges 5 hosszúságú listából a jókat.

seriesComposition[fvek_,arg__]:=Through[Apply[Composition,
Map[Reverse,FoldList[Append,{},fvek]],
1][arg]]

seriesComposition[{fg,gh,hk},ex]

seriesComposition[funs,expr]

Nyomkövetés

Ha már megvan, használjuk másra. Vizsgáljuk a kiértékelés folyamatát (vö. Trace).

(1/(Sin[Log[Exp[(π/2)]]]))

{((#)/2)&,Exp,Log,Sin}

seriesComposition[{((#)/2)&,Exp,Log,Sin},π]

Néha ez kell neki: Exp[#]&

HF.: Többváltozósakra?