Programozási stílusok/paradigmák

Procedurális, szabályalapú (mintaillesztő), funkcionális, obejktumorientált, listakezelő stb. stb. Mind megvan, a funkcionális és a szabályalapú a (megtanulásra méltó) újdonság. Mathematica programozás :)

Funkcionális programozás (+listakezelés)

Bevezetés

Hatékony, áttekinthető. Fv az elsődleges, fvek kiértékelése zajlik. Eltűnnek a ciklusok, és ami azokhoz kell (gyűjtőrekesz, index).

array=RandomReal[{-1,1},100000];
(sum=0;Do[sum+=array[[i]],{i,1,Length[array]}];sum)//Timing

FoldList[ff,x0,{a,b}]//TableForm

Fold[Plus,0,array]//Timing

Timing[Total[array]]

Procedurálisnál: végtelen sok segédváltozó, C-ben a compiler optimalizálja, Mmaban nem, ezért se használjuk. A funkcionális program viszont olyan, mint az optimalizált.

Alapelemek

Map,Apply,Nest,Fold

lista={1,{1},{1,2}};

zz/@{1,{1},{1,2}}

Hold/@lista

zz@@{1,{1},{1,2}}

zz@@@{1,{1},{1,2}}

TreeForm[lista]

Apply[zz,{1,{1},{1,2}},{1}](*pontosan az első szinten, rövid alakja: @@@ *)

NestList[zz,{1,{1},{1,2}},3]

NestList[zz,{1,{1},{1,2}},3]//TableForm

Nest[zz,{1,{1},{1,2}},3]

FoldList[zz,0,{1,{1},{1,2}}]//TableForm

Fold[zz,0,{1,{1},{1,2}}]//TableForm

DownValues, UpValues

ClearAll[f];
f[0]:=1;f[1]:=1;f[n_Integer]:=n f[n-1];

f[12]

DownValues[f]

Milyen sorrendben fogja keresni az illesztendő mintázatokat? Átdefiniálható, pl.

DownValues[f]=DownValues[f][[{2,1,3}]]

Beépítetteket szeretnénk újradefiniálni. Így lehet, de nem ajánlott:

Unprotect[Plus,Times];
Plus[quaternion[a1_,b1_,c1_,d1_],quaternion[a2_,b2_,c2_,d2_]]:=quaternion[a1+a2,b1+b2,c1+c2,d1+d2];
Times...
Protect[Plus,Times]

Tartozzék a def. inkább a quaternion-hoz, mint a Plus-hoz:

Plus[quaternion[a1_,b1_,c1_,d1_],quaternion[a2_,b2_,c2_,d2_]]^:=quaternion[a1+a2,b1+b2,c1+c2,d1+d2];

?quaternion

UpValues[quaternion]

Alternatív, kifejezi, h a quaternion-hoz tartozó UpValue-ról van szó:

quaternion /:Plus[Complex[r_,im_],quaternion[a1_,b1_,c1_,d1_]]:=...

Előnyök: nem bántjuk a beépítetteket, és nem vizsgáltatjuk végig mindig a beépített (gyakori) függvényeket.

Attribútumok

Flat

Listable

{HoldPattern[quaternion[a1_,b1_,c1_,d1_]+quaternion[a2_,b2_,c2_,d2_]]:>quaternion[a1+a2,b1+b2,c1+c2,d1+d2]}

Log[{1,2,E,tyu}]

HoldFirst,HoldRest,HoldAll

Orderless

OneIdentity

Attributes[Plus]

Attributes/@{Set,SetDelayed}

Attributes[f]={Listable,Protected}

Megjegyzések a funkcionális nyelvekről

Kifejezések kiértékelése (nem utasítások mellékhatással: C, eredményt magától nem ad, tárolni kell), és ez a cél is, nem a mellékhatás

Do[Print[(n^2)],{n,4}]

t={};Do[If[PrimeQ[(2^n)-1],AppendTo[t,n]],{n,100}];t

Tisztán funkcionális nyelv: mellékhatás nélküli (felépítése miatt)

Egyszeri hozzárendelés (single-assignment) hatáskörön (scope) belül. Pl. Haskell, Erlang. Mathematica: általában nem ilyen (pedig átláthatóbb), kivétel:

With[{x=y},Hold[x]]
Hold[y]

With[{y=Sin[1.0]},Sum[(y^i),{i,0,10}]](*többször kell*)

With[{x=y},Hold[x]](*bemászunk a Holdba*)
Hold[y]

Timing[Do[Module[{x=5},Log[x];],{(10^5)}]]

Timing[Do[With[{x=5},Log[x];],{(10^5)}]]

Gyorsabb, mint a Module.

Tiszta függévnyek (λ-kalkulus)

Szigorú (azonnali kiértékelés) — nem szigorú: lazy evaluation (amikor kell). Mathematica : inkább szigorú

Currying, closure

Listák listájára akarunk alkalmazni egy fv-t, úgy, h a listák maguk argumentumok legyenek.

Map[ff,{{1,2,3},{4,5,6,7,8},{9,10,11,12}}]

Map[Apply[ff,#]&,{{1,2,3},{4,5,6,7,8},{9,10,11,12}}]

Map[Apply[Plus,#]&,{{1,2,3},{4,5,6,7,8},{9,10,11,12}}]

Plus@@#&/@{{1,2,3},{4,5,6,7,8},{9,10,11,12}}

FullForm[Hold[Plus@@#&/@{{1,2,3},{4,5,6,7,8},{9,10,11,12}}]]

TreeForm[%]

Egyszerűbben is megy:

Plus@@@{{1,2,3},{4,5,6,7,8},{9,10,11,12}}

Total/@{{1,2,3},{4,5,6,7,8},{9,10,11,12}}

Bonyolultabb feladatok:

Plus[1,##]&@@@{{1,2,3},{4,5,6,7,8},{9,10,11,12}}

Plus[#2,##]&@@@{{1,2,3},{4,5,6,7,8},{9,10,11,12}}

TotCost[qty_,price_]:=qty price;

Rest[order[vevo2,1,17.99]]

Map[Apply[TotCost,Rest[#]]&,{order[vevo1,10,4.98],order[vevo2,1,17.99],order[vevo1,12,0.25]}]

TotCost@@@(Rest/@{order[vevo1,10,4.98],order[vevo2,1,17.99],order[vevo1,12,0.25]})

DiscTotCost[qty_,price_,disc_]:=qty price(1-(disc/100.));

DiscTotCost[#3,#4,#2]&@@@{order[vevo1,5,10,4.98],order[vevo2,0,1,17.99],order[vevo1,15,12,0.25]}

Listára alkalmazható függvény készítése

SetAttributes[fff,Listable];
fff[x_]:=x+1;
fff[{1,2,3,4}]

1+Range[4]

Érdemes használni:

First[Timing[Log/@RandomReal[{1,1000},1000000]]]

Timing[Log[RandomReal[{1,1000},1000000]];]

Több függvény listára

{#,((#)^2),((#)^3)}&/@{1,7,3,8,5,9,6,4,2}//TableForm

Thread[{#,((#)^2),((#)^3)}&[{1,7,3,8,5,9,6,4,2}]]//TableForm

Tóth, J.; Ván, P. : Applying a list of functions to an argument : a dual of Map, Mathematica in Education and Research 9 (3/4) (2000), 58–63.

Egysoros

Grid[Partition[If[PrimeQ[#],Framed[#],#]&/@Range[100],10]]

A listaelem sorszámától is függjön a függvényérték

MapIndexed[gg,{a,b,c,d,e}]

MapIndexed[gg,{{a,b},{c,d}},{2}]

MapIndexed[gg[#1,First[#2]]&,{a,b,c,d,e}]

Polinomot gyártunk együtthatókból:

Plus@@MapIndexed[#1(x^(First[#2]))&,{a,b,c,d}]

Block[{poly=0,list={a,b,c,d}},Do[poly=poly+list[[i]] (x^i),{i,1,Length[list]}];poly]

Block[{poly=0,list={a,b,c,d}},Do[poly+=list[[i]] (x^i),{i,Length[list]}];poly]

De így is:

(x^(Range[4]))

{a,b,c,d}.(x^(Range[4]))

Mozgó részlistára alkalmazzunk függvényt

SeedRandom[99];
array=RandomReal[{0,10},20];
Table[Mean@@{array[[i;;i+4]]},{i,1,16}]

SeedRandom[99];
array=RandomReal[{0,10},20];
Table[Mean@@{Take[array,{i,i+4}]},{i,1,16}]

Egymás utáni párok

Table[List@@array[[i;;i+1]],{i,1,19}]

Prefix és posztfix: olvashatóság :)

Adott alakú prímek:

somePrimes1[nmax_]:=Select[Union[Flatten[Table[{(2^n)-1,(2^n)+1},{n,0,nmax}]]],PrimeQ];
somePrimes1[5]

Flatten: kiszedi a zárójeleket

somePrimes2[nmax_]:=Select[Union@Flatten@Table[{(2^n)-1,(2^n)+1},{n,0,nmax}],PrimeQ];
somePrimes2[5]

Hangsúly

somePrimes3[nmax_]:=Select[#,PrimeQ]&@Union@Flatten@Table[{(2^n)-1,(2^n)+1},{n,0,nmax}];
somePrimes3[5]

Ez is megy

somePrimes4@nmax_:=Select[#,PrimeQ]&@Union@Flatten@Table[{(2^n)-1,(2^n)+1},{n,0,nmax}];
somePrimes4[5]

Select the primes of the union of the flattening of the table of pairs {(2^n)-1,(2^n)+1} with n rangig from 0 to nmax.

A funkcionális purista így írja:

somePrimes5:=Select[#,PrimeQ]&@Union@Flatten@Table[{(2^n)-1,(2^n)+1},{n,0,#}]&;
somePrimes5[5]

Tanuljuk meg ezt is elolvasni:)

Lényetelen, afterthought (a lépcsőházból): posztfix. Időmérés, formázás

Last@somePrimes5[500]//Timing

(Melyik a leggyorsabb?)

10.00+12.77-36.00-42.01//AccountingForm

Precedencia

a@b@c//f@d//e

Fvek indexszel

f[1][x_,y_]:=0.5(x+y);
f[2][x_,y_]:=0.5(x-y);
f[3][x_,y_]:=0.5(-x+y);

Table[f[RandomInteger[{1,3}]][3,2],{i,6}]

(Subscript[f, 1])[x_,y_]:=0.5(x+y);
(Subscript[f, 2])[x_,y_]:=0.5(x-y);
(Subscript[f, 3])[x_,y_]:=0.5(-x+y);

(Subscript[f, RandomInteger[{1,3}]])[3,2]

Stan Wagontól, iterált fvrendszerek

f[1][{x_,y_}]:=(({{0.85, 0.04}, {-0.04, 0.85}})).{x,y}+{0,1.6};
f[2][{x_,y_}]:=(({{-0.15, 0.28}, {0.26, 0.24}})).{x,y}+{0,0.44};
f[3][{x_,y_}]:=(({{0.20, -0.26}, {0.23, 0.22}})).{x,y}+{0,1.6};
f[4][{x_,y_}]:=(({{0., 0.}, {0., 0.16}})).{x,y};
ff[p_]:=f[RandomChoice[{85,7,7,1}->{1,2,3,4}]][p];
fern[n_]:=Graphics[{AbsolutePointSize[0.5],Point/@NestList[ff,{0,0},n]},PlotRange->{{-3,3},{-1,11}},AspectRatio->0.83,ImageSize->Small];

fern[10000]

Másféle indexek:

g[{1,1}][x_,y_]:=x+2y;
g[elvadult][x_,y_]:=Exp[Sin[x]Tan[y]];
g[1+2I][x_,y_]:=x+2y I;
Table[g[j][3,4],{j,{{1,1},elvadult,1+2I}}]

Fold és rekurzió

FoldList[ff,x0,{a,b}]//TableForm

ClearAll[mySum1];
mySum1[{}]:=0;
mySum1[l_]:=First[l]+mySum1[Rest[l]];

mySum1[{1,2,3,4,5}]

ClearAll[mySum2];
mySum2[l_]:=Fold[#1+#2&,0,l];

mySum2[{1,2,3,4,5}]

Absztrakt rekurzióból nemrekurzívat

ClearAll[g];
g[{}]:=x;
g[l_]:=f[First[l],g[Rest[l]]]

Ha f asszociatív:

g[l_]:=Fold[f[#1,#2]&,x,l]

Példa

myMap1[_,{}]:={};
myMap1[f_,l_]:=Prepend[myMap1[f,Rest[l]],f[First[l]]]

myMap1[ffgg,{ss,dd}]//Trace//TableForm

ClearAll[myMap2];
myMap2[f_,l_]:=Fold[Prepend[#1,f[#2]]&,{},Reverse[l]];

myMap2[ffgg,{ss,dd,ffff,gg}]

myMap2[ffgg,{}]

Más tanulságok

ClearAll[myMap0];
myMap0[f_,l_List]:=myMap0[f,{},l];
myMap0[f_,{x___},{y_,z___}]:=myMap0[f,{x,f[y]},{z}];
myMap0[_,l_,{}]:=l;
myMap0[ffgg,{ss,dd,ffff,gg}]

Házi feladatok

1. Írjunk programot véletlen számok generálására Neumann János módszere alapján.

2. Készítsünk táblázatot az első 12 szabályos sokszögről, írjuk a belsejükbe az oldalak számát és a szomszédos oldalak bezárta szöget.

3. Mozgó átlagot és egymás utáni párokat készítsünk másképpen, többféleképpen. (MovingAverage, MovingMedian, ListConvolve, ListCorrelate; Partition, LeftRotate, Inner)

4. Írjunk fordított Fold-ot (Haskell: foldr) és FoldList-et. Mikor ad azonos eredményt Fold és FoldL?

Mit ad eredményül? (Néhány gyakorló feladat kezdőknek)

Mielőtt végrehajtanánk, próbáljuk meg kitalálni!

a=1;b=2;c=3;d=4;e=5;
Print[a+b,b+c,c+d,d+e,e+a]

Tanh[Log[x]]

(Sqrt[3+4I])

Cos[ArcSin[((x^2)/(1+(x^2)))]]

Power[aa,bb,cc]

?*crement

Marad

Példák

Írjon progamot, amely a FactorInteger függvény eredményéből előállítja a bemenetet, azaz az argumentumot!

15!
szam=FactorInteger[15!]

1. megoldás

megoldas=1;
Timing[For[i=1,i≤Length[szam],i++,megoldas=megoldas ((szam[[i,1]])^(szam[[i,2]]))];megoldas]

2. megoldás

megoldas=1;
Timing[i=1;While[i≤Length[szam],megoldas=megoldas*((szam[[i,1]])^(szam[[i,2]]));i++];megoldas]

3. megoldás

hatvany[a_,b_]:=(a^b);Timing[
(∏_(i=1)^(Length[szam]))hatvany[szam[[i,1]],szam[[i,2]]]]

Nincs gyűjtőrekesz.

4. megoldás

hatvany[a_,b_]:=(a^b);
Timing[
megoldas=1;
For[i=1, i≤Length[szam],i++,megoldas =megoldas*hatvany[szam[[i,1]],szam[[i,2]]]];megoldas]

5. megoldás

Egy nem túl hatékony megoldás - matematikai tudással...

Timing[
l=szam;
i=1;
k=1;
(∏_(i=1)^(Length[l]))Det[DiagonalMatrix[Table[l[[i,1]],{j,1,l[[i,2]]}]]]]

MemoryInUse[]

6. megoldás

l=szam;
i=1;
megoldas=1;
Timing[
Do[megoldas=megoldas* ((l[[i,1]])^(l[[i,2]])),{i,1,Length[l],1}];megoldas]

7. megoldás

Elemenként építsük fel az alábbi programot.

szam

Timing[Times@@(Power@@#&/@szam)]

Timing[Times@@(Power@@@szam)]

ClearAll[ff];
ff[x_]:=Timing[Times@@(Power@@#&/@x)]

Próbáljuk ki nagyobb számra is a programokat, és nézzük a futásidőket, memóriahasználatot.

A megoldások kinyerése

Milyen módon lehet előállítani a (q^2) egész számot pontosan k egész szám négyzeteinek összegeként?

q=5;
Reduce[{(a^2)+(b^2)+(c^2)==(q^2)},{a,b,c},Integers]

Készítsünk egy listát, ami a megfelelő számhármasokat tartalmazza!

ClearAll[a,b,c]

Apply[List,Reduce[{(a^2)+(b^2)+(c^2)==(q^2)},{a,b,c},Integers],1]

Apply[List,Reduce[{(a^2)+(b^2)+(c^2)==(q^2)},{a,b,c},Integers],1]/.{Equal->Rule}

Apply[List,Apply[List,Reduce[{(a^2)+(b^2)+(c^2)==(q^2)},{a,b,c},Integers],1]/.{Equal->Rule}]

Sols={a,b,c}/.%

Hogy állítjuk elő a már meglévő Sols halmazból a monoton megoldásokat?

Join[Select[Sols,#[[1]]≤#[[2]]≤#[[3]]&],Select[Sols,#[[3]]≤#[[2]]≤#[[1]]&]]

Hasonló, csak mintaillesztéssel.

Cases[Sols,{_?Positive,0,_?Negative}]⋃Cases[Sols,{_?Negative,0,_?Positive}]

A hivatalos megoldás...

Hyperlink["SOS", "http://mathworld.wolfram.com/SumofSquaresFunction.html"]

...mint mindenre, erre is (majdnem) van beépített parancs.

SumOfSquaresRepresentations[d_,n_]:=Module[{x,a},
(a=Array[x,d]) /. {ToRules[Reduce[a.a==n,a,Integers]]}
]

ClearAll[d,n,x,a,SumOfSquaresRepresentations];
SumOfSquaresRepresentations[d_,n_]:=Module[{x,a},(a=Array[x,d])/.{ToRules[Reduce[a.a==n,a,Integers]]}]

(SumOfSquaresRepresentations[3,#]&/@Range[10,20])

SumOfSquaresRepresentations[3,7]

(SumOfSquaresRepresentations[3,#]&/@Range[10,20])[[6]]

{{x$110[1],x$110[2],x$110[3]},x$1020[2],x$1020[3]}

{{x$110[1],x$110[2],x$110[3]},x$1020[2],x$1020[3]}

Keressék meg a helyes utasítást, EZ NEM JÓ!

FullForm[x$110[1]]

ToCharacterCode["x$110[1]"]

sos=(SumOfSquaresRepresentations[3,#]&/@Range[10,20])

Map[Head[First[#]]&,sos]

tot={{x$1612[1],x$1612[2],x$1612[3]},{{-4,0,0},{0,-4,0},{0,0,-4},{0,0,4},{0,4,0},{4,0,0}}};

Map[Head[First[#]]&,tot]

Select[tot,Except[Head[First[#]]== List]&]

Select[tot,Except[Head[First[#]]≠ List]&](*Miért nem megy?*)

Cases[tot,Except[Head[First[#]]== List]&](*Miért nem megy?*)

Select[tot,(Head[First[#]]==  List&)]

Complement[(SumOfSquaresRepresentations[3,#]&/@Range[200]),Select[(SumOfSquaresRepresentations[3,#]&/@Range[200]),(Head[First[#]]== List)&]]

Length[%]

Select[(SumOfSquaresRepresentations[3,#]&/@Range[10,20]),TrueQ[(Head[First[#]]≠  List&)]]

Head[First[#]]&

SumOfSquaresRepresentations[3,61]

Házi feladat: Gyűjtsünk olyan parancs-párokat, amelyek ugyanazt csinálják, csak rendre függvénymegadás-, illetve mintaillesztéses technikával.

Programozásról

Alapvető eszközök

If

Ha ez van, minden van. If[cond,true,false,otherwise]

f:=If[#>3,((#)^2)]&

f/@Range[10]

f[1]

f[22]

f[e]

g=If[#>1,((#)^2),"NEM TUDOM"]&

g@0

g[-1]

Egymásba skatulyázott If-ek helyett: Switch, Which!

For, While, Do

Lehet, de minek. Van Goto is.

For

For[start,test,body,incr]

For[i=1,i<10,i++,x=2;y=3]

x

y

Kiértékelés: start, aztán ciklusban: test, body, incremention.
C-től eltérő a vessző és a pontosvessző szerepe.
Amint a test rész Fail-t ad vissza, a ciklus véget ér.

For[i=1,i<10,i++,x=i]
x

Hol tart a programunk?

For[i=1,i<(10^6),i++,If[Mod[i,(10^5)]==0,Print[i]]]

For[i=1,i<(10^6),i++,If[Mod[i,(10^5)]==0,Beep[]]]

Az igazi megoldás

Monitor,EvaluationMonitor

FindRoot[(x^2)-2,{x,1},EvaluationMonitor:>Print["x = ",x," (x^2) - 2 =",(x^2)-2]]

Play[Sin[440 2π t],{t,0,1}]

Play[Sum[Sin[1000 Sqrt[n] t(1+Cos[n t])],{n,10}],{t,0,1}]

Play[Sum[Sin[2000 2^t n t],{n,5}],{t,0,4}]

For[i=1,i<(10^6),i++,If[Mod[i,(10^5)]==0,Speak["lashutchkaan"]]]

While

n=1;
While[n<4,Print[n];n++]

{a,b}={27,6};
While[b≠0,{a,b}={b,Mod[a,b]}];
a

x=1.0;i=0;
While[Cos[x]≠x,x=Cos[x];i++];{x,i}

Length[FixedPointList[Cos,1.0,SameTest->(Abs[#1-#2]<2 (10^(-14))&)]]

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

Do

Do[Print[(n^2)],{n,4}]

t={};Do[If[PrimeQ[(2^n)-1],AppendTo[t,n]],{n,100}];t

Írjuk azt, amit gondolunk:

sel[n_]:=Select[Range[n],PrimeQ[(2^(#))-1]&]

sel[100]

Aki kapja, marja: Throw és Catch

f[x_]:=If[x>10,Throw["túlcsordulás"],x!]

Catch[f[2]+f[11]]

Catch[f[2]+f[5]]

Az első megfelelő elem kinyerése

n=1000;
Catch@While[n<(10^10),If[And[PrimeQ[n],PrimeQ[(2^n)-1]],Throw[n]];n++]

NestList[ff,x0,2]

Catch[NestList[If[#>1000,Throw[#],((#)^2)+1]&,2,6]]

Ki mint vet, úgy arat: Reap, Sow

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

Reap[Sum[Sow[(i^2)]+1,{i,10}]]

Module, Block, With

Összetettebb függvények írása lokális változók kezelésével.
A külső globális j változó nem jelenik meg a modulon belül. A modul saját, belső változós j paramétere, és a Table[] iterációs változója is különböző.
Figyeljük meg a mintaillesztést is!

Clear[h,y,x,z,j]
j=5;
h[x_?IntegerQ]:=Module[{j},Print[j];j=4;Print@Table[j,{j,j,x}];Print[j]]

A lokális változók a futtatást követően eltűnnek.

h[12]

j

?j

A Module[] testében az inputváltozó értékét nem módosíthatjuk.

Clear[f,x]
f[x_]:=Module[{},x=2;x]

f[4]

gg[l_]:=Module[{n=Length[l]},...]

Clear[Swap,a,b,c];
{a,b,c}={3,2,1};
Swap:=Module[{c},c=b;b=a;a=c;{a,b,c}]

Table[Append[Swap,c],{5}]

Clear[a,b,c];
{a,b,c}={3,2,1};
Table[Swap,{5}]

Másik kettő is van :)

Példák

Írjon progamot, amely a FactorInteger függvény eredményéből előállítja a bemenetet, azaz az argumentumot!

15!
szam=FactorInteger[15!]

1. megoldás

megoldas=1;
Timing[For[i=1,i≤Length[szam],i++,megoldas=megoldas ((szam[[i,1]])^(szam[[i,2]]))];megoldas]

2. megoldás

megoldas=1;
Timing[i=1;While[i≤Length[szam],megoldas=megoldas*((szam[[i,1]])^(szam[[i,2]]));i++];megoldas]

3. megoldás

hatvany[a_,b_]:=(a^b);Timing[
(∏_(i=1)^(Length[szam]))hatvany[szam[[i,1]],szam[[i,2]]]]

Nincs gyűjtőrekesz.

4. megoldás

hatvany[a_,b_]:=(a^b);
Timing[
megoldas=1;
For[i=1, i≤Length[szam],i++,megoldas =megoldas*hatvany[szam[[i,1]],szam[[i,2]]]];megoldas]

5. megoldás

Egy nem túl hatékony megoldás - matematikai tudással...

Timing[
l=szam;
i=1;
k=1;
(∏_(i=1)^(Length[l]))Det[DiagonalMatrix[Table[l[[i,1]],{j,1,l[[i,2]]}]]]]

MemoryInUse[]

6. megoldás

l=szam;
i=1;
megoldas=1;
Timing[
Do[megoldas=megoldas* ((l[[i,1]])^(l[[i,2]])),{i,1,Length[l],1}];megoldas]

7. megoldás

Elemenként építsük fel az alábbi programot.

szam

Timing[Times@@(Power@@#&/@szam)]

Timing[Times@@(Power@@@szam)]

ClearAll[ff];
ff[x_]:=Timing[Times@@(Power@@#&/@x)]

Próbáljuk ki nagyobb számra is a programokat, és nézzük a futásidőket, memóriahasználatot.

Ámde: Külön engedéllyel használható szavak listája

Az alábbi szavak használatához külön engedély kell (aki ,,tud" programozni, az különösen veszélyeztetett):

Goto és Label 
    Break
    Continue
    Do
    For
    Length
    Print
    Return

Jól gondolja meg azt is valaki, hogy a Table vagy a Length függvényre van-e szüksége. Ezek helyett: funkcionális programozási struktúrákat, mintaillesztést, listakezelést, akármit használhatunk, de nem szedünk szét egy matematikai objektumot elemeire azért, hogy azután összerakjuk, hasonlóan (de szigorúbban, mert lehet és mert érdemes) ahhoz, ahogyan lineáris algebrában amíg lehet, nem használunk koordinátákat.

Példa a Do használatára: Nagy táblázatot kiszámolok vele, a memóriában marad, majd kiírom, jöhet a következő nagy táblázat.

Felmerült szorgalmi feladatok, szabad gondolkodni rajtuk

Keressük meg a legkisebb olyan Mersenne-prímet, amely utolsó 3 számjegye 111.

A FactorInteger eredményéből: (2^11)(3^6) stb.

Select[lista, fQ], fQ predikátum, fQ értéke True vagy False. Pl. NumberQ, EvenQ.
Feladat: Cases-szel ugyanez, ahol a listából mintázattal választunk ki valamit. És fordítva.

Valahogyan csináljunk Until-t.

Milyen módon lehet előállítani a (q^2) egész számot pontosan k egész szám négyzeteinek összegeként?

q=5;
Reduce[{(a^2)+(b^2)+(c^2)==(q^2)},{a,b,c},Integers]

Készítsünk egy listát, ami a megfelelő számhármasokat tartalmazza!

ClearAll[a,b,c]

Apply[List,Reduce[{(a^2)+(b^2)+(c^2)==(q^2)},{a,b,c},Integers],1]

Apply[List,Reduce[{(a^2)+(b^2)+(c^2)==(q^2)},{a,b,c},Integers],1]/.{Equal->Rule}

Apply[List,Apply[List,Reduce[{(a^2)+(b^2)+(c^2)==(q^2)},{a,b,c},Integers],1]/.{Equal->Rule}]

Sols={a,b,c}/.%

Hogy állítjuk elő a már meglévő Sols halmazból a monoton megoldásokat?

Join[Select[Sols,#[[1]]≤#[[2]]≤#[[3]]&],Select[Sols,#[[3]]≤#[[2]]≤#[[1]]&]]

Hasonló, csak mintaillesztéssel.

Cases[Sols,{_?Positive,0,_?Negative}]⋃Cases[Sols,{_?Negative,0,_?Positive}]

A hivatalos megoldás...

Hyperlink["SOS", "http://mathworld.wolfram.com/SumofSquaresFunction.html"]

...mint mindenre, erre is (majdnem) van beépített parancs.

SumOfSquaresRepresentations[d_,n_]:=Module[{x,a},
(a=Array[x,d]) /. {ToRules[Reduce[a.a==n,a,Integers]]}
]

ClearAll[d,n,x,a,SumOfSquaresRepresentations];
SumOfSquaresRepresentations[d_,n_]:=Module[{x,a},(a=Array[x,d])/.{ToRules[Reduce[a.a==n,a,Integers]]}]

(SumOfSquaresRepresentations[3,#]&/@Range[10,20])

SumOfSquaresRepresentations[3,7]

(SumOfSquaresRepresentations[3,#]&/@Range[10,20])[[6]]

{{x$110[1],x$110[2],x$110[3]},x$1020[2],x$1020[3]}

{{x$110[1],x$110[2],x$110[3]},x$1020[2],x$1020[3]}

Keressék meg a helyes utasítást, EZ NEM JÓ!

FullForm[x$110[1]]

ToCharacterCode["x$110[1]"]

sos=(SumOfSquaresRepresentations[3,#]&/@Range[10,20])

Map[Head[First[#]]&,sos]

tot={{x$1612[1],x$1612[2],x$1612[3]},{{-4,0,0},{0,-4,0},{0,0,-4},{0,0,4},{0,4,0},{4,0,0}}};

Map[Head[First[#]]&,tot]

Select[tot,Except[Head[First[#]]== List]&]

Select[tot,Except[Head[First[#]]≠ List]&](*Miért nem megy?*)

Cases[tot,Except[Head[First[#]]== List]&](*Miért nem megy?*)

Select[tot,(Head[First[#]]==  List&)]

Complement[(SumOfSquaresRepresentations[3,#]&/@Range[200]),Select[(SumOfSquaresRepresentations[3,#]&/@Range[200]),(Head[First[#]]== List)&]]

Length[%]

Select[(SumOfSquaresRepresentations[3,#]&/@Range[10,20]),TrueQ[(Head[First[#]]≠  List&)]]

Head[First[#]]&

SumOfSquaresRepresentations[3,61]

Házi feladat: Gyűjtsünk olyan parancs-párokat, amelyek ugyanazt csinálják, csak rendre függvénymegadás-, illetve mintaillesztéses technikával.

Programozásról

Alapvető eszközök

If

Ha ez van, minden van. If[cond,true,false,otherwise]

f:=If[#>3,((#)^2)]&

f/@Range[10]

f[1]

f[22]

f[e]

g=If[#>1,((#)^2),"NEM TUDOM"]&

g@0

g[-1]

Egymásba skatulyázott If-ek helyett: Switch, Which!

For, While, Do

Lehet, de minek. Van Goto is.

For

For[start,test,body,incr]

For[i=1,i<10,i++,x=2;y=3]

x

y

Kiértékelés: start, aztán ciklusban: test, body, incremention.
C-től eltérő a vessző és a pontosvessző szerepe.
Amint a test rész Fail-t ad vissza, a ciklus véget ér.

For[i=1,i<10,i++,x=i]
x

Hol tart a programunk?

For[i=1,i<(10^6),i++,If[Mod[i,(10^5)]==0,Print[i]]]

For[i=1,i<(10^6),i++,If[Mod[i,(10^5)]==0,Beep[]]]

Az igazi megoldás

Monitor,EvaluationMonitor

FindRoot[(x^2)-2,{x,1},EvaluationMonitor:>Print["x = ",x," (x^2) - 2 =",(x^2)-2]]

Play[Sin[440 2π t],{t,0,1}]

Play[Sum[Sin[1000 Sqrt[n] t(1+Cos[n t])],{n,10}],{t,0,1}]

Play[Sum[Sin[2000 2^t n t],{n,5}],{t,0,4}]

For[i=1,i<(10^6),i++,If[Mod[i,(10^5)]==0,Speak["lashutchkaan"]]]

While

n=1;
While[n<4,Print[n];n++]

{a,b}={27,6};
While[b≠0,{a,b}={b,Mod[a,b]}];
a

x=1.0;i=0;
While[Cos[x]≠x,x=Cos[x];i++];{x,i}

Length[FixedPointList[Cos,1.0,SameTest->(Abs[#1-#2]<2 (10^(-14))&)]]

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

Do

Do[Print[(n^2)],{n,4}]

t={};Do[If[PrimeQ[(2^n)-1],AppendTo[t,n]],{n,100}];t

Írjuk azt, amit gondolunk:

sel[n_]:=Select[Range[n],PrimeQ[(2^(#))-1]&]

sel[100]

Aki kapja, marja: Throw és Catch

f[x_]:=If[x>10,Throw["túlcsordulás"],x!]

Catch[f[2]+f[11]]

Catch[f[2]+f[5]]

Az első megfelelő elem kinyerése

n=1000;
Catch@While[n<(10^10),If[And[PrimeQ[n],PrimeQ[(2^n)-1]],Throw[n]];n++]

NestList[ff,x0,2]

Catch[NestList[If[#>1000,Throw[#],((#)^2)+1]&,2,6]]

Ki mint vet, úgy arat: Reap, Sow

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

Reap[Sum[Sow[(i^2)]+1,{i,10}]]

Module, Block, With

Összetettebb függvények írása lokális változók kezelésével.
A külső globális j változó nem jelenik meg a modulon belül. A modul saját, belső változós j paramétere, és a Table[] iterációs változója is különböző.
Figyeljük meg a mintaillesztést is!

Clear[h,y,x,z,j]
j=5;
h[x_?IntegerQ]:=Module[{j},Print[j];j=4;Print@Table[j,{j,j,x}];Print[j]]

A lokális változók a futtatást követően eltűnnek.

h[12]

j

?j

A Module[] testében az inputváltozó értékét nem módosíthatjuk.

Clear[f,x]
f[x_]:=Module[{},x=2;x]

f[4]

gg[l_]:=Module[{n=Length[l]},...]

Clear[Swap,a,b,c];
{a,b,c}={3,2,1};
Swap:=Module[{c},c=b;b=a;a=c;{a,b,c}]

Table[Append[Swap,c],{5}]

Clear[a,b,c];
{a,b,c}={3,2,1};
Table[Swap,{5}]

Másik kettő is van :)

Példák

Írjon progamot, amely a FactorInteger függvény eredményéből előállítja a bemenetet, azaz az argumentumot!

15!
szam=FactorInteger[15!]

1. megoldás

megoldas=1;
Timing[For[i=1,i≤Length[szam],i++,megoldas=megoldas ((szam[[i,1]])^(szam[[i,2]]))];megoldas]

2. megoldás

megoldas=1;
Timing[i=1;While[i≤Length[szam],megoldas=megoldas*((szam[[i,1]])^(szam[[i,2]]));i++];megoldas]

3. megoldás

hatvany[a_,b_]:=(a^b);Timing[
(∏_(i=1)^(Length[szam]))hatvany[szam[[i,1]],szam[[i,2]]]]

Nincs gyűjtőrekesz.

4. megoldás

hatvany[a_,b_]:=(a^b);
Timing[
megoldas=1;
For[i=1, i≤Length[szam],i++,megoldas =megoldas*hatvany[szam[[i,1]],szam[[i,2]]]];megoldas]

5. megoldás

Egy nem túl hatékony megoldás - matematikai tudással...

Timing[
l=szam;
i=1;
k=1;
(∏_(i=1)^(Length[l]))Det[DiagonalMatrix[Table[l[[i,1]],{j,1,l[[i,2]]}]]]]

MemoryInUse[]

6. megoldás

l=szam;
i=1;
megoldas=1;
Timing[
Do[megoldas=megoldas* ((l[[i,1]])^(l[[i,2]])),{i,1,Length[l],1}];megoldas]

7. megoldás

Elemenként építsük fel az alábbi programot.

szam

Timing[Times@@(Power@@#&/@szam)]

Timing[Times@@(Power@@@szam)]

ClearAll[ff];
ff[x_]:=Timing[Times@@(Power@@#&/@x)]

Próbáljuk ki nagyobb számra is a programokat, és nézzük a futásidőket, memóriahasználatot.

Ámde: Külön engedéllyel használható szavak listája

Az alábbi szavak használatához külön engedély kell (aki ,,tud" programozni, az különösen veszélyeztetett):

Goto és Label 
    Break
    Continue
    Do
    For
    Length
    Print
    Return

Jól gondolja meg azt is valaki, hogy a Table vagy a Length függvényre van-e szüksége. Ezek helyett: funkcionális programozási struktúrákat, mintaillesztést, listakezelést, akármit használhatunk, de nem szedünk szét egy matematikai objektumot elemeire azért, hogy azután összerakjuk, hasonlóan (de szigorúbban, mert lehet és mert érdemes) ahhoz, ahogyan lineáris algebrában amíg lehet, nem használunk koordinátákat.

Példa a Do használatára: Nagy táblázatot kiszámolok vele, a memóriában marad, majd kiírom, jöhet a következő nagy táblázat.

Felmerült szorgalmi feladatok, szabad gondolkodni rajtuk

Keressük meg a legkisebb olyan Mersenne-prímet, amely utolsó 3 számjegye 111.

A FactorInteger eredményéből: (2^11)(3^6) stb.

Select[lista, fQ], fQ predikátum, fQ értéke True vagy False. Pl. NumberQ, EvenQ.
Feladat: Cases-szel ugyanez, ahol a listából mintázattal választunk ki valamit. És fordítva.

Valahogyan csináljunk Until-t.

Új házi feladatok

1. Keressünk valóságos adatokat (pl. KSH, vagy ?*Data), olvassuk be azokaz (szükség esetén az Import függvénnyel), és igazoljuk vagy cáfoljuk azokon a Benford-törvényt.

2. Hol fordul elő először π számjegyei között a 2010 számjegysorozat? (Csak annak, aki nem volt órán. Aki volt, oldja meg a Position felhasználásával.)

3. Határozzuk meg mindazokat a P polinomokat, amelyekre Δ u=0 esetén a v:=u ◦ P összefüggéssel értelmezett függvényre Δ v=0 is fennáll.

4. Írjunk Until függvényt, írjunk ,,fordított'' Fold-ot.

Előző házi feladatok

1. Határozzuk meg az alábbi függvény összes aszimptotáját:

ℝ\{-5,1}∋x↦((2(x^2)-3x+5)/((x-1)(x+5))).

Plot[((2(x^3)-3x+5)/((x-1)(x+5))),{x,-9,6},Exclusions->{(x-1)(x+5)==0}]

Grid@Table[Plot[((2(x^3)-3x+5)/((x-1)(x+5))),{x,-6,6},PlotPoints->pp,MaxRecursion->mr],{mr,{0,1,2}},{pp,{5,10}}]

Limit[((2(x^3)-3x+5)/((x-1)(x+5)))(1/x),x->+∞]

Limit[((2(x^3)-3x+5)/((x-1)(x+5)))-2x,x->+∞]

Limit[((2(x^3)-3x+5)/((x-1)(x+5)))-(2x-8),x->+∞]

2. Állítsuk elő minél többféle módon a Hilbert-mátrixokat!

h1[n_]:=Table[(1/(i+j-1)),{i,n},{j,n}]

h2[n_]:=Array[(1/(#1+#2-1))&,{n,n}]

h3[n_]:=(1/(Outer[Plus,Range[n],Range[n]-1]))

MatrixForm[h3[3]]

Timing

3. Vizsgáljuk meg a Hilbert-mátrixok többi sajátértékének a mérettől való függését!

ClearAll[ev];
ev[nmax_,k_]:=Flatten[Table[Eigenvalues[HilbertMatrix[n,WorkingPrecision->2 n+20],k],{n,nmax}]];
ListLogPlot[ev[32,-1]]

ListLogPlot[ev[32,5]]//Quiet

4. Lineáris algebra (haladó)

Írjunk olyan függvényt, amely egy lineáris egyenletrendszernek meghatározza együttható mátrixát és jobb oldalát, tehát így működik:

ToMatrix[{(Subscript[a, 11])(Subscript[x, 1])+(Subscript[a, 12])(Subscript[x, 2])==(Subscript[b, 1]),(Subscript[a, 21])(Subscript[x, 1])+(Subscript[a, 22])(Subscript[x, 2])==(Subscript[b, 2])}]

eredménye

{{{(Subscript[a, 11])+(Subscript[a, 12])},{(Subscript[a, 21]),(Subscript[a, 22])}},{(Subscript[b, 1]),(Subscript[b, 2])}}

Map[Coefficient[#[[1]],(Subscript[x, 1])]&,{(Subscript[a, 11])(Subscript[x, 1])+(Subscript[a, 12])(Subscript[x, 2])==(Subscript[b, 1]),(Subscript[a, 21])(Subscript[x, 1])+(Subscript[a, 22])(Subscript[x, 2])==(Subscript[b, 2])}]

Map[Coefficient[#[[1]],{(Subscript[x, 1]),(Subscript[x, 2])}]&,{(Subscript[a, 11])(Subscript[x, 1])+(Subscript[a, 12])(Subscript[x, 2])==(Subscript[b, 1]),(Subscript[a, 21])(Subscript[x, 1])+(Subscript[a, 22])(Subscript[x, 2])==(Subscript[b, 2])}]

Map[#[[2]]&,{(Subscript[a, 11])(Subscript[x, 1])+(Subscript[a, 12])(Subscript[x, 2])==(Subscript[b, 1]),(Subscript[a, 21])(Subscript[x, 1])+(Subscript[a, 22])(Subscript[x, 2])==(Subscript[b, 2])}]

tomatrix1[eqs_List]:={Map[Coefficient[#[[1]],{(Subscript[x, 1]),(Subscript[x, 2])}]&,eqs],Map[#[[2]]&,eqs]}

tomatrix1[{(Subscript[a, 11])(Subscript[x, 1])+(Subscript[a, 12])(Subscript[x, 2])==(Subscript[b, 1]),(Subscript[a, 21])(Subscript[x, 1])+(Subscript[a, 22])(Subscript[x, 2])==(Subscript[b, 2])}]

MatrixForm/@%

tomatrix2[eqs_List,vars_]:={Map[Coefficient[#[[1]],vars]&,eqs],Map[#[[2]]&,eqs]}

tomatrix2[{(Subscript[a, 11])(Subscript[x, 1])+(Subscript[a, 12])(Subscript[x, 2])==(Subscript[b, 1]),(Subscript[a, 21])(Subscript[x, 1])+(Subscript[a, 22])(Subscript[x, 2])==(Subscript[b, 2])},{(Subscript[x, 1]),(Subscript[x, 2])}]

Tetszőleges számú változóra!

Az alábbi még nem jó

{Map[ff,{x,y}],Map[gg,{x,y}]}

Map[#,{x,y}]&/@{ff,gg}

tomatrix3[eqs_List,vars_]:=Map[#,vars]&/@{(Coefficient[#[[1]],vars]&),(#[[2]]&)}

tomatrix3[{(Subscript[a, 11])(Subscript[x, 1])+(Subscript[a, 12])(Subscript[x, 2])==(Subscript[b, 1]),(Subscript[a, 21])(Subscript[x, 1])+(Subscript[a, 22])(Subscript[x, 2])==(Subscript[b, 2])},{(Subscript[x, 1]),(Subscript[x, 2])}]

Map[Coefficient[#[[1]],{(Subscript[x, 1]),(Subscript[x, 2])}]&,{(Subscript[a, 11])(Subscript[x, 1])+(Subscript[a, 12])(Subscript[x, 2])==(Subscript[b, 1]),(Subscript[a, 21])(Subscript[x, 1])+(Subscript[a, 22])(Subscript[x, 2])==(Subscript[b, 2])}]

Marad

sol=Solve[(x^3)-3(x^2)+1==0,x]

fs=FullSimplify[x/.sol]

ip=IntegerPart[((fs[[1]])^1993)]

PowerMod[1+2 Cos[(π/9)],1993,17]

PowerMod works with numbers of any size, and does not need to compute the explicit power:

PowerMod-nál: RSA

NSolve[(x^3)-3(x^2)+1==0,x]