4. Házi feladat

1. feladat 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.)

Bartha Zsolt

<<Combinatorica`
NumberOfDerangements[4]

9-féleképpen tudtak botot csrélni.

2 pont

Bartha Klára

l={1,2,3,4}
k=Permutations[l]
k[[24]]
t={}
For[i=2,i≤24,i++,If[(k[[i,1]]-k[[1,1]])*(k[[i,2]]-k[[1,2]])*(k[[i,3]]-k[[1,3]])*(k[[i,4]]-k[[1,4]])≠0,AppendTo[t,k[[i]]]]]
Length[t]

For nélkül?

2 pont

Fekete Samu

<<DiscreteMath`Combinatorica`

Mindenki valaki más botját használja, tehát a megoldás éppen a fixpontmentes permutációk száma 4 elemen. Erre a függvény:

0 pont

Fekete Marcell

n=0
For[i=0,i<4,i++,
For[j=0,j<4,j++,
If[i≠j&&i≠0&&j≠1,For[k=0,k<4,k++,
If[i≠k&&j≠k&&k≠2,For[l=0,l<4,l++,
If[l≠i&&l≠j&&l≠k&&l≠3,n++]]
]]]]]
n

Nem szép!

2 pont

Forberger Klaudia

mindenkinél más horgászbotja = összes eset - van olyan, akinél a saját pecabotja van

összes eset:

p=Permutations[{a,b,c,d}]

Hiányzott: p=
emiatt az alábbiak nem működtek.

Az első horgásznál a saját pecabotja van:

Ah={} ;
For[n=1,n< Length[p],n++,If[p[[n]][[1]] == a, AppendTo[Ah,p[[n]]]]]
Print[Ah]

A második horgásznál a saját pecabotja van:

Bh={} ;
For[n=1,n< Length[p],n++,If[p[[n]][[2]] == b, AppendTo[Bh,p[[n]]]]]
Print[Bh]

A harmadik horgásznál a saját pecabotja van:

Ch={} ;
For[n=1,n< Length[p],n++,If[p[[n]][[3]] == c, AppendTo[Ch,p[[n]]]]]
Print[Ch]

A negyedik horgásznál a saját pecabotja van:

Dh={} ;
For[n=1,n< Length[p],n++,If[p[[n]][[4]] == d, AppendTo[Dh,p[[n]]]]]
Print[Dh]

Van, akinél a sajátja van:

Union[Ah,Bh,Ch,Dh]

Length[Permutations[{a,b,c,d}]]-Length [Union[Ah,Bh,Ch,Dh]]

9-féleképpen csrélhettek.

2 pont

Bonyolultabban nem lehetne?

És ez mi?

A,B,C,D : horgászok
a,b,c,d : horgászbotok

GraphPlot[{"A"->"b","A"->"c","A"->"d","B"->"a","B"->"c","B"->"d","C"->"a","C"->"b","C"->"d","D"->"a","D"->"b","D"->"c"},VertexLabeling->True,PlotStyle->Directive[Thick,Orange]]

Geszler Döme

1.Megoldás

Select[Permutations[Range[4]],MemberQ[Table[#[[i]]==i,{i,4}],True]==False &]

Length[%]

2.Megoldás

Select[Permutations[Range[4]],Count[Table[#[[i]]==i,{i,4}],True]==0&]

Length[%]

3.Megoldás

Select[Permutations[Range[4]],Union[Table[#[[i]]==i,{i,4}]]=={False}&]

Length[%]

4 pont

Igen derék!És mindegyik működik tetszőleges számra.

Holubecz Judit

<<Combinatorica`
Length[MinimumChangePermutations[{A,B,C,D}]]

Ez mi?

0 pont

Kiss Ágnes

<<Combinatorica`

Length[HamiltonianCycle[CompleteGraph[4],All]]

horgasz[m_]:=Length[Permutations[m-1]]

horgasz[4]

Ez mi?

0 pont

És ez micsoda?

f[a_,b_]:=a-> b

ClearAll[l];
l[n_]:=HamiltonianCycle[MakeDirected[CompleteGraph[n]],All]

l[4]

Apply[f,Partition[l[4][[1]],2,1],2]

A megoldás:

f[a_,b_]:=a-> b

abrak[p_]:=Table[GraphPlot[Apply[f,Partition[l[p][[i]],2,1],2],VertexLabeling->True, DirectedEdges->True],{i,Length[HamiltonianCycle[CompleteGraph[p],All]]}]

abrak[4]

abrak[5]

Lelkes Ádám

Mivel mind a négy horgász valaki más horgászbotját szeretné kipróbálni, 4 elem fixpont nélküli permutációinak számát kell meghatározni. Erre a Combinatorica csomag NumberOfDerangements függvénye való. A Derangements függvény pedig meg is adja a fixpontmentes permutációkat.

<<Combinatorica`

NumberOfDerangements[4]

Derangements[4]

2 pont

Nagy László

<<Combinatorica`

Length[MinimumChangePermutations[{a,b,c,d}]]

Ez mi?

0 pont

Palej Gréta

<<Combinatorica`

Length[MinimumChangePermutations[{a,s,d,f}]]

Ez mi?

0 pont

Pap Máté

n=Range[4];
m=Permutations[n];
l={};
For[k=1,k≤Length[m],k++,
If[m[[k,1]]≠1&&m[[k,2]]≠2&&m[[k,3]]≠3&&m[[k,4]]≠4,
l=Append[l,m[[k]]];
]
]
Length[l]

2 pont

For nélkül?

Papp Artúr

Mivel mindegyik horgász kicseréli a botját, ezért ezt vissza lehet vezetni 4 elem fixpont nélküli permutációinak a számára!

f[n_]:=n!*Sum[((-1)^k)/k!,{k,0,n}]

f[4]

Avagy a másik megoldás :

g[x_]:=Subfactorial[x]

g[4]

Avagy a harmadik megoldás, azaz vesszük 4 elem összes permutációját és töröljük azokat amelyekben 1,2,3,4 legalább egyike helyén marad:

Length[DeleteCases[Permutations[Range[4]],{1,__}|{_,2,__}|{__,3,_}|{__,4}]]

Hogyan csinálná 4 helyett n-re az utolsót?

Nagyon szép!

4 pont

Podonyi Anikó

<<Combinatorica`

a,b,c,d-vel jelöltem a négy horgászt. Az első horgász a saját botján kívül hármat választhat, a második szintén hármat (ha az első horgász a második botját választotta) a harmadiknak még két lehetősége van, ha a második az ő botját választotta, az utolsónak pedig egy lehetősége maradt.

3 3 2

Ha az első horgász nem a második horgász botját választja, akkor neki még 2 lehetősége van a 3 helyett, mert a sajátját nem választhatja. Ha a második horgász nem a harmadik botját választja, akkor a harmadik horgásznak is csak egy lehetősége marad, mivel a sajátját nem választhatja. Az első és az utolsó horgász ugyan annyit választhat, mint az előbb.

3 2

Ha az első horgász nem a második horgász botját választja, akkor neki még 2 lehetősége van a 3 helyett, mert a sajátját nem választhatja. Ha a második horgász a harmadik botját választja, akkor a harmadik horgásznak két lehetősége marad. Az első és az utolsó horgász ugyan annyit választhat, mint az előbb.

3 2 2

Ha az első horgász a második horgász botját választja, akkor neki még 3 lehetősége van. Ha a második horgász nem a harmadik botját választja, akkor a harmadik horgásznak egy lehetősége marad, mivel a sajátját nem választhatja. Az első és az utolsó horgász ugyan annyit választhat, mint az előbb.

3 3

Ezekhez még hozzájön egy négyes szorzó, mivel nem tudjuk melyik horgász választ elsőnek.

Nem jön hozzá :)

4 helyett n-re?

1 pont

Szép Enikő

Az "n" elem fixpont nélküli permutációt kell kiszámolni:

<<Combinatorica`

NumberOfDerangements[4]

2 pont

Torma Lídia Boglárka

<<Combinatorica`

Horgaszok={a,b,c,d}

MinimumChangePermutations[Horgaszok]

Itt az összes sorrend. Azonban le kell vonnunk belőle azokat az eseteket, amikor valamelyik pecabot a gazdájánál marad.

Clear[H]

Ha külön cellába írja a Clear-t, mit sem ér...

H={}

For[i=1,i≤Length[MinimumChangePermutations[Horgaszok]],i++,For[j=1,j≤Length[Horgaszok],j++,If[MinimumChangePermutations[Horgaszok][[i]][[j]]==Horgaszok[[j]],H=Append[H,MinimumChangePermutations[Horgaszok][[i]]] ]]]

Complement[MinimumChangePermutations[Horgaszok],H]

A lehetséges cserék száma :

Length[Complement[MinimumChangePermutations[Horgaszok],H]]

2 pont

Kicsikét bonyolult

Varga Gábor

L={1,2,3,4};
S=Permutations[L];
T={};
For[i=1,i≤Length[S],i++,
If[S[[i,1]] ≠ 1 && S[[i,2]]≠ 2 && S[[i,3]] ≠ 3 && S[[i,4]]≠ 4,
T=Append[T,S[[i]] ];
]
]
Length[T]

2 pont

Kicsit csúf, és: 4 helyett n-re?

Horgászokhoz kieg.

Select[Permutations[Range[4]],((#[[1]]≠1)∧(#[[2]]≠2)∧(#[[3]]≠3)∧(#[[4]]≠4))&]

Select[Permutations[Range[4]],And@@Table[(#[[i]]≠i),{i,4}]&]

HammingDistance[{2,1,4,3},{1,2,3,4}]

Select[Permutations[Range[4]],(HammingDistance[#,Range[4]]==4)&]

sel[n_]:=Select[Permutations[Range[n]],(HammingDistance[#,Range[n]]==n)&]

sel[4]

TableForm[Length[sel[#]]&/@Range[6],TableHeadings->{Range[6],None}]

Euler not only gives the first ten or so terms of the sequence, he also proves both recurrences  a(n)=(n-1)(a(n-1)+a(n-2)) and a(n)=na(n-1)+(((-1))^n).

ClearAll[rsola,a,n];
rsola=RSolve[{a[n]==(n-1)(a[n-1]+a[n-2]),a[1]==0,a[2]==1},a[n],n]

a[n]/.rsola[[1]]/.n->5//FullSimplify

rsolb=RSolve[{b[n]==n b[n-1]+(((-1))^n),b[1]==0},b[n],n]//Quiet

b[n] /. First@rsolb /. n -> 5 // FullSimplify

Hyperlink["Sloane","http://www.research.att.com/~njas/sequences/index.html?q=0%2C1%2C2%2C9%2C44%2C265&language=english&go=Search"]

2. feladat Rajzoljunk meg négy vagy akárhány halmazra olyan ábrát, amely az összes lehetséges viszonyt mutatja.

Bartha Zsolt

Graphics[{
Red,Rotate[Circle[{0,0},{1,1.5}],Pi/4,{0,-1}],
Blue,Rotate[Circle[{0,0},{1,1.5}],-Pi/4,{0,-1}],
Green,Rotate[Circle[{0.7,0.7},{1,1.5}],Pi/4,{0.7,-0.3}],
Purple,Rotate[Circle[{-0.7,0.7},{1,1.5}],-Pi/4,{-0.7,-0.3}]
}]

2 pont

4 helyett n-re?

Fekete Samu

Írtam egy manipulate-et amivel 4 gömböt lehet mozgatni, és a sugarukat állítani. Ezeket Venn-diagrammoknak tekintve ábrázolható az összes eset:

Manipulate[ContourPlot3D[{(x-x1)^2+(y-y1)^2+(z-z1)^2==r1^2,(x-x2)^2+(y-y2)^2+(z-z2)^2==r2^2,(x-x3)^2+(y-y3)^2+(z-z3)^2==r3^2,(x-x4)^2+(y-y4)^2+(z-z4)^2==r4^2},{x,-20,20},{y,-20,20},{z,-20,20},Mesh-> None, ContourStyle -> {Directive[Orange],Directive[Blue],Directive[Green],Directive[Red]}],{x1,-10,10},{y1,-10,10},{z1,-10,10},{r1,0.1,20},{x2,-10,10},{y2,-10,10},{z2,-10,10},{r2,0.1,20},{x3,-10,10},{y3,-10,10},{z3,-10,10},{r3,0.1,20},{x4,-10,10},{y4,-10,10},{z4,-10,10},{r4,0.1,20}]

0 pont

Nem látom igazán a hasznát...

Geszler Döme

Graphics[{Thickness[0.01],Yellow,Circle[{0,0},1],Blue,Circle[{1,0.5},1],Red,Circle[{1,-0.5},1],Green,Circle[{1,-0.5},0.75,{0,Pi}],Circle[{1,-0.5},1.25,{0,Pi}],Circle[{0,-0.5},0.25,{Pi,2 Pi}],Circle[{2,-0.5},0.25,{Pi,2 Pi}]}]

2 pont

4 helyett n-re?

Lelkes Ádám

Akárhány=3 halmazra Venn-diagram (nem szeretek rajzolni):

0 pont :(

Pallag Mónika

j:=5
PolarPlot[{j, Table[Sin[2^i*t]/2i+j, {i, j-1}]},{t,0,2Pi}]

Mi is ez?

1 pont

Podonyi Anikó

ShowGraph[CompleteGraph[4],VertexLabel->{"a","b","c","d"}]

Manipulate[ShowGraph[CompleteGraph[n],VertexNumber->True],{n,1,20,1}]

Animate[ShowGraph[CompleteGraph[n],VertexNumber->True],{n,1,20,1}]

0 pont

Ez mi?

Szép Enikő

4 halmazt ábrázoló Venn-diagram: 
(Venn azt gondolta, hogy 5 halmazra nem létezik konvex alakzatokból álló diagram, de Branko Grünbaum mutatott ilyet ellipszisekből. )

Graphics[{Rotate[Circle[{0,0},{2,5}],30Degree], Rotate[Circle[{1.5,1.5},{2,5}],25Degree], Rotate[Circle[{2.5,1.5},{2,5}],-25Degree], Rotate[Circle[{4,0},{2,5}],-30Degree]}]

2 pont

Ábra n-re?

Torma Lídia Boglárka

Manipulate[PolarPlot[{2n*Cos[x+1],2n*Sin[x+1],n,Table[Sin[2^i*x]/3i+n,{i,n-3}]},{x,0,2Pi}],{n,3,10,1}]

Megjegyzés : http : // en.wikipedia.org/wiki/Venn_diagram # Edwards .27 _Venn _diagrams
Ez alapján csináltam. A leírásban a kifejezést 2 i - vel osztják, viszont szerintem 3 i - vel jobban néz ki.
   n a halmazok száma, itt 10 - ig vettem, és azokat az eseteket nem néztem, mikor n = 0, 1, 2.

3 pont!

3. feladat
Valamelyik korábbi függényt egészítsük ki opcióval és alapértelmezés szerinti értékkel. (Szabad ellopni a másét - feltéve, h a lopó megértette a működését! - a honlapomról evégett.)

Bartha Klára

f[x_]:=((2 (x^3)-x+1)/((x+2)(x-3)))
Manipulate[Plot[((2 (x^u)-x+1)/((x+2)(x-3))),{x,-10,10}],{u,-10,10,1}]

Manipulate[expr,control]

0 pont

Bartha Zsolt

ClearAll[foldr,foldrlist,f,x0,list, a, b, c];
foldr[f_, x0_:0, {}]:=x0
foldr[f_, x0_:0, list_]:=f[list[[1]],foldr[f, x0, list[[2;;]]]]
Default[foldrlist,1]=#1+#2&;
Default[foldrlist,2]=0;
foldrlist[f_., x0_., list_]:=Table[foldr[f, x0, list[[i;;]]],{i,Length[list]+1,1,-1}]

foldr[f, {a,b,c}]

foldrlist[f, {a,b,c}]//TableForm

foldrlist[{a,b,c}]//TableForm

ClearAll[foldrlist,f];
Default[foldrlist,2]=0;
Options[foldrlist]={f->#1+#2&};
foldrlist[opt__?OptionQ, x0_., list_]:=Module[{fv},fv=f/.{opt}/.Options[foldrlist];Table[foldr[fv, x0, list[[i;;]]],{i,Length[list]+1,1,-1}]]

2 pont

Fekete Samu

A movingaverage függvényt írtam át úgy, hogy ha nem adunk meg neki második paramétert, akkor azt autómatikusan 2-nek vegye, azaz a listát 2 elemenként átlagolja.

movingaverage[l_,r_:2]:=Flatten[Join[List[Mean@l[[1;;r]],movingaverage[Drop[l,1],r]]]] /;r<Length[l]
movingaverage[l_,r_:2]:=Mean@l/; r==Length[l]

movingaverage[{2,3,7,4,6}]

movingaverage[{2,3,7,4,6},2]

movingaverage[{2,3,7,4,6},3]

2 pont

Geszler Döme

FibList[n_.]:= Table[Fibonacci[i],{i,0,n}]

Ez így nem megy.

Default[FibList]=10

Ezt a fvdef előtt kell megadni.

FibList[]

FibList[10]

1.5 pont

Lelkes Ádám

Az alábbi példa a Collatz-sorozat komplex számsíkra való kiterjesztését mutatja be, még a múltkori informatika gyakorlaton kezdtem írni.
A sorozat rekurzív definícióját a CollatzNext függvény adja meg, a sorozat adott kezdőértéktől számított tagjait a Collatz függvény számolja ki, opcionális argumentumként limitálni lehet az iterációk számát és a sorozat tagjainak abszolútértékét, hiszen nem egész értékekre gyorsan el tud szállni a sorozat, és jellemzően nem lesz fixpontja.
A függvény ábrázolására is mutatok példát.

CollatzNext[z_]:=(1/4)(2+7z-(2+5z)Cos[π z])

Options[Collatz]={maxiter->Infinity,maxv-> Infinity};
Collatz[z0_,OptionsPattern[]]:=Module[{l,z},l={};z=z0;While[!MemberQ[N/@l,N[CollatzNext[z]]]&&Length[l]<OptionValue[maxiter]&&(Length[l]==0||Abs[Last[l]]<OptionValue[maxv]),z=CollatzNext[z];AppendTo[l,z]];l]

Collatz[23]

f[a_,b_]:=If[(Collatz[a+b I,maxiter->100,maxv->1000000]//Last//Abs)>1000000,1,0]

ContourPlot[f[x,y],{x,-1,1},{y,-1,1}]

g[a_,b_]:=Collatz[a+b I,maxiter->100,maxv->1000000]//Last//Abs
Plot3D[g[x,y],{x,-1,1},{y,-1,1},Mesh->None,PerformanceGoal->Speed]

4 pont

Papp Artúr

Manipulate[PolarPlot[{1,Abs[2+(E^(-I π(a+ Cos[t])))+(E^(-I π(b+2 Cos[t])))]},{t,-π,π},PlotRange->All,PlotStyle->{Hue[RandomReal[]],Directive[Dashed,Thick,Blue]}],{a,-5,5},{b,-5,5}]

Szép, de mi ez?

0 pont

Podonyi Anikó

g=((x y)/((x^2)+(y^2)));
ContourPlot[g,{x,-100,100},{y,-100,100},PlotLabel->g,ColorFunction->"DarkRainbow",ContourStyle->{White,Directive[Gray,Dashed]},Axes->False,Frame->False, BoundaryStyle->White,RegionFunction->Function[{x,y,z},500<=x^2+y^2<=10000]]

Nem az opciók használatát gyakoroljuk már!

0 pont

Ilyet inkább ne írjon:

g=((x y)/((x^2)+(y^2)));

Torma Lídia Boglárka

SetOptions[Plot,PlotStyle->FaceForm[Red]]

0 pont

Varga Gábor

veletlen[a_,b_]:=Module[{k,h,L},
k=a;
h=b;
L={k};
For[i=2,i≤h,i++,
s=Characters[ToString[k^2]];
s1={};
For[j=IntegerPart[Length[s]/2] -3,j<=IntegerPart[Length[s]/2]+4,j++,s1=Append[s1,s[[j]] ] ];
s1=FromDigits[StringJoin[s1]];
L=Append[L,s1];
k=s1;
]
L
]
Default[veletlen,1]=11111111;
Default[veletlen,2]=5;

veletlen[]

veletlen[234,3]

Ez micsoda?

0 pont

Az elmélet folytatása

Eljárások (szubrutinok)

Module - lokális változók

Minden egyes alkalommal, amikor a Module-t alkalmazzuk, a Mathematica új szimbólumot vezet be a lokális változókra. Az új szimbólumok neve mind különböző és a következő alakú: lokális változó neve + $ + sorozatszám. Például:

Quit[]

Module[{a},Print[a]]

Module[{a,b}, Print[a]; Print[b]]

A Module minden egyes használatakor a $ModuleNumber változó értéke növekszik:

{$ModuleNumber, Module[{a},a], $ModuleNumber}

Az értékét mi is beállíthatjuk:

$ModuleNumber=1000;{Module[{a},a],$ModuleNumber}

Hibeüzenetet kapunk, mert az egymás utáni sorozatszámok közt később lehet azonos:

$ModuleNumber=10;{Module[{a},a],$ModuleNumber}

Miért jó, hogy mi is beállíthatjuk? A modulok által generált szimbólumok általában csak egy adott munkamenet során egyediek. A $ModuleNumber változó értéke a Mathematica (Kernel) minden újraindításakor visszaállítódik. Tehát ha olyan kifejezéseket mentünk, melyben generált szimbólumok vannak, akkor új munkamanetet kezdve az újragenerált és a már meglévő szimbólumok között lehet azonos. Ezt úgy lehet elkerülni, hogy a $ModuleNumber-t mindig újraállítjuk, pl. $ModuleNumber=10^10 $SessionID. A $SessionID globális változó olyan egyedi számot ad meg, ami meghatároz egy adott Mathematica munkamenetet egy adott számítógépen (az abszolút időből, IP-címből).

Nyomon követhetjük a számolást és láthatjuk a szimbólumokat:

Trace[Module[{x}, x=3]]

A szimbólumokkal végezhetünk műveleteket is:

x$19+2

Szerezhetünk róluk információt:

?x*

Temporary: a modulokon belül generált szimbólumok megszűnnek, ha a modul végrehajtása befejeződött. Például:

Module[{q},(q^2)+1]

?q*

Most a modulon belül új változó jön létre:

Module[{q}, Print[q]]

Ez viszont eltűnik, mert a modul végrehajtása befejeződött:

?q*

Module[{q}, Print[q]]

?q*

Kiértékelés

Miután elkészültek a lokális változóknak megfelelő szimbólumok, a Module[vars,body] kiértékeli a body-t a szimbólumok felhasználásával. Először veszi a body-nak megfelelő aktuális kifejezést, behelyettesíti a lokális változóknak megfelelő szimbólumokat, végül kiértékeli a kifejezést.

A Module a szimbólumokat csak a body-ban szereplő explicit alakba helyettesíti be. Például

g=(n^2)+2; Module[{n=5}, g]

Mivel a g-ben explicit módon nem szerepel az n, az 5-öt nem helyettesíti be, csak kiírja a g-t. Ezen így segíthetünk:

g=(n^2)+2; Module[{n=5}, Evaluate[g]]

Attributes[Module]

A HoldAll tulajdonság azt jelenti, hogy a body kiértékeletlenül marad, míg a modul nem hajtódik végre.

until::usage="until[cond,cmd] repeats evaluating cmd until cond is True.";

SetAttributes[until,HoldAll]

until[cond_,cmd_]:=While[True,cmd;If[cond,Return[]]]

i=1;
until[Prime[i]>(10^6),i++];i

g=(n^2)+2; With[{n=5}, g]

g=(n^2)+2; Block[{n=5}, g]

Module és Block

Quit[]

Mit várunk?

m=(i^2)

Block[{i=a},i+m]

Module[{i=a},i+m]

bb[x_]:=Block[{i}, Sum[(x^i),{i,1,5}]]

{bb[a], bb[i]}

cc[x_]:=Module[{i}, Sum[(x^i),{i,1,5}]]

{cc[a],cc[i]}

With - lokális konstansok

A Module lokális változókat hozhatunk létre, melyekhez értékeket rendelhetünk és aztán megváltoztathatjuk őket. A With ezzel szemben lokális konstansokat készít, melyekhez egyszer rendelünk értéket.

Quit[]

t=5

Az f függényben a t szám lokális konstans:

f[x_]:=With[{t=x+1},t+(t^2)]

f[a]

Megmarad t globális értéke:

t

f[t]

Ugyanúgy, mint a Module-nál, a kezdeti értékadás kiértékelődik, mielőtt a With végrehajtódik:

With[{t=t+1},(t^2)]

A With[{x=(Subscript[x, 0]),…},body] úgy működik, hogy x helyébe (Subscript[x, 0])-t stb. ír mindenhol, ahol az a body-ban előfordul. A példában: az x-et a-val helyettesítjük, ezután a body a=5, így az a globális értéke 5 lesz.

ClearAll[x,a];
With[{x=a}, x=5]

{a,x}

Mit várunk a Module-nál és a Blocknál?

ClearAll[x,a];
Module[{x=a}, x=5]

{a,x}

Block

A Module a változók neveit lokálisan kezeli. Ezzel szemben a Block a változók neveit globálisan, az értékeit lokálisan kezeli.

Quit[]

(x^2)+3

A Block kiértékeli a fenti kifejezést úgy, hogy az x-nek lokálisan az a+1 értéket adja:

Block[{x=a+1}, %]

Az x-nek nincs globális értéke:

x

Ezzel szemben a Module kiértékeletlenül visszadná a 3+(x^2)-et. Adjunk a t-nek értéket:

Module[{x=a+1}, %%%]

t=22

A Module-on belül létrejön egy egyedi szimbólum, ami minden egyes végrehajtás során más, és különbözik a globális t-től.

Module[{t}, Print[t]]

A Block-on belül ezzel szemben a változók megtartják a globális nevüket, de értékük lokálisan megváltozik:

Block[{t},Print[t]]

Block[{t},t=50;(t^2)+10t]

A Block végrehajtása után a t visszakapja korábbi értékét.

t

Iterációk

Nest, NestList

Nest[f,x,5]

NestList[f,x,5]

Nest[(1+#)^2&,x,5]

Nest[((#)^2)&,2,6]

NestList[((#)^2)&,2,6]

Nest[Sqrt, 100., 5]

NestList[Sqrt, 100., 5]

Program (Sqrt[2])értékének kiszámítására. Az (Subscript[x, k+1])=(1/2)((Subscript[x, k])+(n/(Subscript[x, k]))) rekurzív képlettel adott sorozat konvergens, és határértéke (Sqrt[n]). Ebben a példában (Subscript[x, 0])=1, n=2, és 5 iterációt nézünk.

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

FixedPoint, PixedPointList

Kicsit másképp az előző példa: számítsuk ki a (Sqrt[10]) értékét:

newton10[x_]:=N[1/2 (x+10/x)]

Nézzünk 12 iterációt az 1-ből kiindulva:

NestList[newton10,1.0,12]

A FixedPoint addig alkalmazza ismételten a függvényt, amíg az eredmény már nem változik:

FixedPoint[newton10,1.0]

FixedPointList[newton10,1.0]

Másik példa: a Floor függvény az alsó egészrészt adja meg.

NestList[1+Floor[#/2]&,1000,15]

FixedPointList[1+Floor[#/2]&,1000,15]

A legnagyobb közös osztó meghatározása (nem numerikus alkalmazás!):

FixedPoint[#/.{a_,b_}/;b≠0->{b,Mod[a,b]}&,{28,21}]

FixedPointList[#/.{a_,b_}/;b≠0->{b,Mod[a,b]}&,{28,21}]

GCD[28,21]

FixedPointList[D[#,x]&,x^10]

Mintaillesztés  numerikus alkamazása (!)

1.//.x_->Cos[x]

NestWhile, NestWhileList

NestWhile: Addig alkalmazunk egy függvényt egy kiindulási értékre, amíg egy adott feltétel NEM teljesül. Itt addig osztjuk az 123456-ot 2-vel, amíg az eredmény már nem páros szám:

NestWhile[#/2&,123456,EvenQ]

Listaként:

NestWhileList[#/2&,123456,EvenQ]

4 lépés után megállhatunk, akkor is, ha még mindig páros számnál tartunk:

NestWhile[#/2&,123456,EvenQ,1,4]

NestWhileList[#/2&,123456,EvenQ,1,4]

Az első, 888-nál nagyobb prímszám (itt a ! a Not függvény jele, dupla tagadásról van szó, addig haladunk egyesével fölfelé, amíg nem teljesül, hogy egy szám nem prím):

NestWhile[#+1&,888,!PrimeQ[#]&]

Ha elhagynánk a !-et, 888-at kapnánk, hiszen erre nem teljesül az, hogy prím.

Keressük meg az első, 888-nál nagyobb ikerprímpárt. A 3-as arra utal, hogy a kapott lista utolsó 3 elemét nézzük. Az utolsó 3 elemből #1 utal az első elemre, #2 a másodikra, #3 a harmadikra. A nagyobbik ikerprímet kapjuk meg.

NestWhile[#+1&,888,!PrimeQ[#1]||!PrimeQ[#3]&,3]

NestWhileList[#+1&,888,!PrimeQ[#1]||!PrimeQ[#3]&,3]

Ez is ugyanaz a tagadás:

NestWhile[#+1&,888,!(PrimeQ[#1]&&PrimeQ[#3])&,3]

Mintaillesztés, rekurzió

Cases[{{1,2,3},a,{4,5}},t:{__Integer}:>t^2]

FullForm[t:{__Integer}:>t^2]

RuleDelayed[Pattern[t,List[BlankSequence[Integer]]],Power[t,2]]

f[a]+f[b]/.f[x_]->x^2

Position[{f[a],g[b],f[c]},f[x_]]

f[{a,b}]+f[c]/.f[{x_,y_}]->p[x+y]

g[list_]:=Part[list,1]^Part[list,2]

h[{x_,y_}]:=x^y

{1,x,x^2,x^3}/.x^n_->r[n]

{a/b,1/b^2,2/b^2}/.b^n_->d[n]

FullForm[{a/b,1/b^2,2/b^2}]

f[a+b]+f[a+c]+f[b+d]/.f[a+x_]+f[c+y_]->p[x,y]

Helyettesítés (lokális értékadás)

{x,x^2,y,z}/.x->a

Sin[x]/.Sin->Cos

{a,b,c}/.List->f

1 + x^2 + x^4 /. x^p_ -> f[p]

x/.{x->1,x->3,x->7}

x/.{{x->1},{x->3},{x->7}}

{x,x,x}/.x:>RandomReal[]

Hold[x+x]/. x->7

Hold[x+x]/.x:>2^2

Hold[x+x]/.x->2^2

{a,b,c}/.a->b/.b->d

{a,b,c}/.{a->b,b->d}

h[x+h[y]]/.h[u_]->u^2

h[x+h[y]]//.h[u_]->u^2

log[a b c d]/.log[x_ y_]->log[x]+log[y]

log[a b c d]//.log[x_ y_]->log[x]+log[y]

Replace[f[u],{f[x_]->x^2,f[x_]->x^3}]

ReplaceList[f[u],{f[x_]->x^2,f[x_]->x^3}]

ReplaceList[a+b+c,x_+y_->g[x,y]]

ReplaceList[{a,b,c,d},{x__,y__}->g[{x},{y}]]

ReplaceList[{a,b,c,a,d,b,d},{___,x_,y__,x_,___}->g[x,{y}]]

(Cookbook)

TableForm[{MatchQ[a,_],MatchQ[a[1],_a],MatchQ[a,_a]},TableHeadings->{{"MatchQ[a,_]","MatchQ[a[1],_a]","MatchQ[a,_a]"},None}]

MatchQ[{1,2},_List]

f1[n_Integer]:={n};f2[n__Integer]:={n};f3[n___Integer]:={n};

TableForm[{f1[],f1[10],f1[10,20],f2[10],f2[10,20],f2[],f3[10],f3[10,20],f3[]},TableHeadings->{{"f1[]","f1[10]","f1[10,20]","f2[10]","f2[10,20]","f2[]","f3[10]","f3[10,20]","f3[]"},None}]

Hogyan lehetne a fentit szebben,általános esetben megcsinálni?

Cases[{a,r,t,i,c,h,o,k,e},a|e|i|o|u]

f[x_Complex|x_Real|x_Integer]:=x

f/@{1,π,3.14,10+3I,(1/2),izé}

RegularExpression

StringCases["adefgh12c34",RegularExpression["[a-e]+"]]

StringCases["adefgh12c34",CharacterRange["a","e"]..]

StringMatchQ["abcd\nefgh\n1234",RegularExpression["(\\w|\\s)*"]]

StringMatchQ["abcd\nefgh\n1234",(WordCharacter|Whitespace)...]

Repeated, RepeatedNull

Cases [{{0,0,0},{0,0,1},{0,1,0},{0,1,1},{1,0,0},{1,0,1},{1,1,0},{1,1,1}},{1..,0..}]

Cases [{{0,0,0},{0,0,1},{0,1,0},{0,1,1},{1,0,0},{1,0,1},{1,1,0},{1,1,1}},{1...,0..}]

Cases [{{0,0,0},{0,0,1},{0,1,0},{0,1,1},{1,0,0},{1,0,1},{1,1,0},{1,1,1}},{1...,0...}]

Cases[{a,r,t,i,c,h,o,k,e},Except[a|e|i|o|u]]

Cases [{{0,0,0},{0,0,1},{0,1,0},{0,1,1},{1,0,0},{1,0,1},{1,1,0},{1,1,1}},b__/;Total[b]>1]

Cases [{{0,0,0},{0,0,1},{0,1,0},{0,1,1},{1,0,0},{1,0,1},{1,1,0},{1,1,1}},b:{1..,0..}:> FromDigits[b,2]]

Így is működik, de - jogosan -nem szereti.

Cases [{{0,0,0},{0,0,1},{0,1,0},{0,1,1},{1,0,0},{1,0,1},{1,1,0},{1,1,1}},b:{1..,0..}-> FromDigits[b,2]]

SQL, Mine, Yours, Query

{x,x,x,x}/.x->RandomInteger[{0,100}]

{x,x,x,x}/.x:> RandomInteger[{0,100}]

Új házi feladatok

Írjunk egysorost, amely megadja a (2^n)-1 és (2^n)+1 alakú, (2^50)+2-nél kisebb prímeket.

Írjuk meg (nem elég készen megtalálni!) azt a függvényt, amely előállítja egy irányított gráf tranzitív lezártját.

Az InfoEA51.nb 2. tétele alapján írjunk programot egy polinom aszimptotikus stabilitásának eldöntésére.

Határozzuk meg annak a sorozatnak a tagjait, amelyről a következőket tudjuk: a[0]==1;(∑_(i=`)^n)a[i]a[n-i]==1.

*Bizonyítsuk be, hogy a P polinom minden gyökének abszolút értéke pontosan akkor kisebb egynél, ha x↦P((1+x)(1-x)) aszimptotikusan stabilis polinom.