Predavanje 15: Glava 41

FlipView[{Text[Style[" Branko Urošević, imqfbrankourosevic@gmail.com ",20,"Text",Italic]],Text[Style[" Faculty of Economics, University of Belgrade, NBS and CESIfo Munich",20,"Text", Italic]]}]

41. Još o prepoznavanju oblika za konstruisanje funkcija i transformacija izraza

NestWhileList[Total[IntegerDigits[#]]&,3925,Total[IntegerDigits[#]]≠#&]

NestWhileList[Total[IntegerDigits[#]]&,3925,#>=10&]

funkcija[1209182098103897102978012]

funkcija[n_Integer]/;n≥1:=NestWhile[Total[IntegerDigits[#]]&,n,#>=10&]

funkcija[3925]

Uslovni (Conditional) pattern matching

Sada razmatramo uslovne oblike, odnosno kako zadati jedan ili više uslova na oblike. To je veoma važno prilikom pisanja funkcija i pravila transformacija. Opšta oznaka za uslovne o je expr_/; test. Oblik je uspešno matchovan samo onda kada uslovni test da razultat True.

Pretpostavimo da iz liste brojeva od 1 do 20 hoćemo da izdvojimo samo one koji su kvadrati celih brojeva. Imenujemo oblik n i zahtevamo da je njegov kvadratni koren ceo broj. U tom slučaju sam broj n je kvadrat celog broja.

Cases[{1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20},n_/;IntegerQ[(Sqrt[n])]]

Naravno, to isto možemo da uradimo i bez oblika koristeći Select (ova funkcija i Cases mogu da uradi vrlo slične stvari):

Select[{1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20},IntegerQ[(Sqrt[#])]&]

Izaberimo proste brojeva u listi brojeva od 1 do 100

Module[{lista=RandomInteger[{1,1000},200]},Cases[lista,m_/;And[Mod[m,7]==0,Mod[m,3]!=0]]]

Module[{lista=RandomInteger[{1,1000},200]},Cases[lista,m_/;Mod[m,7]==0]]

%/7

Cases[Range[100],n_/;PrimeQ[n]]

Generišite listu od 200 nasumice odabranih celih brojeva od 1 do 1000, i iz nje izaberite one deljive sa 7. Iskoristite Module

Module[{lista=RandomInteger[{1,1000},200]},Cases[lista,m_/;Mod[m,7]==0]]

Odabir elemenata iz proste liste pomoću više od jednog kriterijuma

Pretpostavimo da želimo da iz liste brojeva od 1 do 1000 odaberemo brojeve koji su prosti i koji se završavaju cifrom 3. Kako to možemo da uradimo koristeći Cases i uslovne oblike.

Cases[Range[1000],n_/;PrimeQ[n]&&Last[IntegerDigits[n]]==3]

Prvi uslov određuje da je u pitanju prost broj. Drugi uslov radi ovako. Prvo rastavimo ceo broj na cifre. Nađemo poslednju cifru. Ukoliko je ona jednaka 3 uslov je zadovoljen. Najzad && je logička oznaka za AND, to jest logičko i.

Pronađi proste brojeve od 1 do 1000 koji se završavaju na 7 i koji su veći od 100

Cases[Range[1000],n_/;PrimeQ[n]&&Last[IntegerDigits[n]]==7&&n>100]

Da li ima više prostih brojeva od 1 do 1000 koji se završavaju na 7 ili koji počinju na 7. Prostih brojeva koji se završavaju 7 ima

Cases[Range[1000],n_/;PrimeQ[n]&&Last[IntegerDigits[n]]==7]//Length

Prostih brojeva koji počinju na 7 ima

Cases[Range[1000],n_/;PrimeQ[n]&&First[IntegerDigits[n]]==7]//Length

Ovo radi, naravno, ne samo u slučaju brojeva nego za bilo koje izraze. Napravimo sada listu stepena promenljive x i izaberimo one koji su parni stepeni x

Cases[{x,(x^2),(x^3),(x^4),(x^5)},_^(n_)/;EvenQ[n]]

Kako pomoću imenovanih oblika nalaziti odgovarajuća rešenja jednačine

O algebarskim jednačinama pričamo kasnije. Sada samo želimo da lkoristeći Solve nađemo rešenja ove algebarske jednačine:

(x^9)+3.4 (x^6)-25 (x^5)-213 (x^4)-477 (x^3)+1012 (x^2)+111 x-123==0

A da onda izvučemo one koja su realna, pozitivna, ili negativa.

Solve[(x^9)+3.4 (x^6)-25 (x^5)-213 (x^4)-477 (x^3)+1012 (x^2)+111 x-123==0,{x}]

realnaresenja=Cases[Solve[(x^9)+3.4 (x^6)-25 (x^5)-213 (x^4)-477 (x^3)+1012 (x^2)+111 x-123==0,{x}],{_-> _Real}]

Cases[realnaresenja,{_-> q_/;q>0}]

Cases[realnaresenja,{_-> q_/;q<0}]

Plot[(x^9)+3.4 (x^6)-25 (x^5)-213 (x^4)-477 (x^3)+1012 (x^2)+111 x-123,{x,-2,2.5}]

Primeri sa stringovima

Razmotrimo listu stringova i izdvojimo iz nje one koji imaju bar 6 slova.

Cases[{"stringovi","prvi i pravi","mama","Ekrem Jevric","farma"},x_String/;StringLength[x]≥ 6]

Iz iste liste stringova izabrati one koji imaju slovo “a” bar 2 puta. Tu je korisna funkcija StringCount.

StringCount["farma","a"]

Cases[{"stringovi","mama","Ekrem Jevric","farma"},x_String/;StringCount[x,"a"]≥ 2]

Naći sve reči u DictionaryLookup[] koje imaju bar 19 karaktera. Koliko ima takvih reči?

Cases[DictionaryLookup[],x_String/;StringLength[x]≥ 19]

Koje su 10  najdužih reči u DictionaryLookup? Koliko su duge?

TakeLargestBy[DictionaryLookup[],StringLength[#]&,10]

StringLength/@TakeLargestBy[DictionaryLookup[],StringLength[#]&,10]

Sada nađimo broj reči u rečniku kao funkciju dužine reči (od 1 do 23)

Table[{duzina,Length[Cases[DictionaryLookup[],x_String/;StringLength[x]≥ duzina]]},{duzina,23}]

ListLinePlot[Table[{duzina,Length[Cases[DictionaryLookup[],x_String/;StringLength[x]≥ duzina]]},{duzina,23}]]

Odabir elemenata iz liste parova, to jest iz složenih listi

Iz sledeće liste parova izdvojiti one elemente kod kojih je druga koordinata manje od 6

Cases[{{1,7},{3,4},{4,4},{5,9}},{_,druga_}/;druga<6]

Imenovani oblik je sada {_,druga_} pošto radimo sa parovima (sećate se, nadam se, da ime oblika može biti potpuno proizvoljno). Uslov kaže prosto da je druga koordinata manja od 6. Izabrati elemente čija je prva koordinata manja ili jednaka 4.

Cases[{{1,7},{3,4},{4,4},{5,9}},{prva_,_}/;prva≤ 4]

Generišimo parove brojeva od 1 do 20. Nađite parove čija je suma deljiva sa 6.

Flatten[Table[{i,j},{i,20},{j,20}],1]

funkcija2[n_Integer,m_Integer]:=Cases[Flatten[Table[{i,j},{i,n},{j,n}],1],{x_,y_}/;Mod[x+y,m]==0]

funkcija2[20,6]

Cases[Flatten[Table[{i,j},{i,20},{j,20}],1],{x_,y_}/;Mod[x+y,6]==0]

Za istu listu brojeva naći Pitagorine parove za koje je suma njihovih kvadrata i sama kvadrat nekog celog broja. Drugim rečima, kvadratni koren iz sume njihovih kvadrata je ceo broj.

pitagoriniBrojevi=Cases[Flatten[Table[{i,j},{i,20},{j,20}],1],{x_,y_}/;IntegerQ[(Sqrt[(x^2)+(y^2)])]&&x≤ y]

pitagora[20]

pitagora[n_Integer]:=Cases[Flatten[Table[{i,j},{i,n},{j,n}],1],{x_,y_}/;IntegerQ[(Sqrt[(x^2)+(y^2)])]&&x≤ y]

Od prethodno dobijene liste Pitagorinih brojeva ostavite samo one kod kojih je prva koordinata manja ili jednaka drugoj. Tako dobijamo jedinstvene parove brojeva (to jest, {3,4} i {4,3} su isti par brojeva po toj logici)

Cases[pitagoriniBrojevi,{prvi_,drugi_}/;prvi≤ drugi]

Primena uslovnih oblika prilikom pisanja funkcija

Pretpostavimo da želimo da napišemo funkciju pinks koja pravi onu tabelu pink kvadratića ali sada želimo da sprečimo da neko unese argument koji nije pozitivan ceo broj. Ima puno načina da se to uradi preko uslovih oblika.

pinks1[n_Integer/;n>0]:=Table[Pink,n]

{pinks1[5.7],pinks1[5]}

Ograničenje možemo staviti i izvan:

pinks2[n_Integer]/;n>0:=Table[Pink,n]

{pinks2[5.7],pinks2[5]}

Na osnovu prethodnog slajda, napisati funkciju pitagora koja uzima kao input n koji je pozitivan ceo broj veći od 3, pravi tabelu parova brojeva od 1 do n, a onda iz njih izvlači jedinstvene pitagorine parove brojeva.

pitagora[n_Integer/;n>3]:=Module[{pitagoriniBrojevi=Cases[Flatten[Table[{i,j},{i,n},{j,n}],1],{x_,y_}/;IntegerQ[(Sqrt[(x^2)+(y^2)])]]},Cases[pitagoriniBrojevi,{prvi_,drugi_}/;prvi≤ drugi]]

pitagora[30]

Još primera za pisanje funkcija koje koriste uslovne oblike

Kako bismo pomoću uslovnih oblika definisali funkciju koja izračunava apsolutno vrednost nekog broja.

abs[x_/;x≥ 0]:=x

abs[x_/;x< 0]:=-x

Proverimo ovu definiciju:

{abs[-17],abs[19]}

Napisati funkciju koja radi sledeće: Ukoliko je input ceo pozitivan broj razbiti ga na cifre, obrnuti redostled cifara, a svaku cifru ponaosob uramiti.

digitback[n_Integer]/;n>0:=Framed/@Reverse[IntegerDigits[n]]

digitback[1209810]

Ova funkcija izračunava kada god je argument ceo broj:

digitback[x_List]:=Framed/@Flatten[x]

{digitback[1234],digitback[6712],digitback[x],digitback[{{4,3,2}}],digitback[2^32]}

Još primera

Definisati funkciju check koja proverata da li je x > y. Ako jeste, funkcija izbaci crveni kvadratić. Ako je manje lii jednako izbaci plavi

check[x_,y_]:=Red/;x>y

check[x_,y_]:=Blue/;x≤ y

Proverimo kako to radi:

{check[1,2],check[2,1],check[3,4],check[50,60],check[60,50]}

A evo kako možemo da napišemo dinamički program za brojeve fibonači gde eksplicitno zahtevamo da argumenti budu pozitivni i celi brojevi.

Clear[f]

f[1]=f[2]=1;

f[n_/;IntegerQ[n]&&Positive[n]]:=f[n]=f[n-1]+f[n-2]

{f[3],f[5],f[1.2],f[-3]}

Skraćenica za uslovne oblike

Postoji skraćena verzija za uslovne patterne koji se često koriste. Uslovni pattern expr_/; test može da se piše i ovako exp_?test. Na primer

Cases[{1,2,3,4,5,6,7,8,9},x_/;PrimeQ[x]]

može ekvivalentno da se napiše i ovako:

Cases[{1,2,3,4,5,6,7,8,9},x_?PrimeQ]

Na sličan način možemo nađemo parne brojeve u listi

Cases[{1,2,3,4,5,6,7,8,9},x_?EvenQ]

Iz ove liste ostavljamo samo brojeve

Cases[{1,2,a,c,3,4,5,6,7,8,9},_?NumberQ]

Evo i primene kod pisanja funkcija ograničene da bude definisana samo za matrice. Proveravamo da li je matrica simetrična.

{{1,2}}//MatrixQ

symmetricMatrixQ[mat_/;MatrixQ[mat]]:=Transpose[mat]==mat

Onda se skraćeno može napisati ovako (ovde je mat ime oblika, a uslov je da je taj oblik matrica).

squareMatrixQ[mat_?MatrixQ]:=Transpose[mat]==mat

SymmetricMatrixQ

symmetricMatrixQ[{{1,3},{3,3}}]

{{1,3},{2,3}}//MatrixForm

symmetricMatrixQ[{{1,3},{2,3}}]

Šta se matchuje a šta ne

MatchQ[{1,2,3},_List]

Pošto je head List a ne Number, ovo dole bi dalo False

MatchQ[{1,2,3},_?NumberQ]

To je isto kao da sam napisao

MatchQ[{1,2,3},broj_/;NumberQ[broj]]

Ako hoćete da matchujete listu koja se sastoji od sekvence brojeva, onda treba da umesto toga uradimo sledeće:

MatchQ[{1,a,3},{__?NumberQ}]

MatchQ[{1,2,3},{__?NumberQ}]

naravno, ovo se onda, ne bi matchovalo (jer nisu svi brojevi)

MatchQ[{1,2,a,3},{__?NumberQ}]

Pošto je π Numeric ali ne i Number, onda bismo imali, na primer, da:

Cases[{1,2,3,π,E},_?NumberQ]

Cases[{1,2,3,π,E},_?NumericQ]

Cases[{-2.7,0,1.2,-3 π},_?Negative]

Alternative (alternatives)

Nekada je potrebno matchovati kriterijum gde postoji više alternativa. To radimo ovako:

Cases[{1,3.1,3+4 I,"Hello"},_Integer|_Real]

Ovako možemo da izaberemo sve brojeve na listi osim 0.

Cases[{-4.73,NAN,-9.3,1,0.0,"NaN"},Except[0,_?NumberQ]]

Primetimo da time nismo izbacili  0.0 pošto 0.0 nije isto što i ceo broj 0. Umesto toga možemo da uradimo sledeće

Cases[{-4.73,NAN,-9.3,1,0.0,"NaN"},Except[0|0.0,_?NumberQ]]

Ovakve stvari su super za filtriranje podataka.

Ponovnjeni oblici (Repeated patterns)

Double black matchuje jedan ili više elemenata. Triple blank matchuje nula ili više elemenata. Na primer, da bismo matchovali proizvoljnu sekvencu brojeva možemo da koristimo double blank sa testom:

MatchQ[{1,2,3,4,5},{__?NumberQ}]

Alternativno, možemo da koristimo Repeated[pattern] koji ima krati zapis dva tačke (..). Ovo matchuje sekvencu jednog ili više brojeva:

MatchQ[{1,2,3,4,5},{_?NumberQ..}]

Na sličan način, postoji RepeatedNull[pattern] (ili ...), oblik koji će matchovati nula ili više izraza koji matchuju pattern. Evo primera:

MatchQ[{},{_?NumberQ...}]

Ukoliko koristite imenovane oblike sa .., ili ...,  svaki izraz matchovan od strane imenovanog patterna mora biti identičan :

MatchQ[{{1,2},{1,4},{1,5}},{{_,_}..}]

MatchQ[{{1,2},{1,4},{1,5}},{{_,q_}..}]

Ovo je False zato što druga koordinata (2, 4, ili 5) nisu isti broj. Sa druge strane,

MatchQ[{{1,2},{1,4},{1,5}},{{q_,_}..}]

Još o ponovljenim oblicima

Ovako možemo izdvojiti parove sa identičnim elementima:

Cases[{{1,2},{1,4},{a,a},{1,5},{7,7}},{q_,q_}..]

Kako da postavljamo uslove na ponovljene oblike

Cases[{{1,2},{1,4},{5,5},{a,a},{1,5},{7,7}},{q_/;NumberQ[q],q_}..]

Primetimo da nismo morali da stavljamo uslove na oba q.  Sada razmotrimo funkciju koja proverama da li je lista celih brojeva ista kao inverzna lista tih istih brojeva. Tu koristimo to da oblik umesto preko x_, ili x__ možemo zapravo da predstavimo ovako: x:{_Integer..}.

reverznaIstaQ[x:{_Integer..}]:=x==Reverse[x]

{reverznaIstaQ[{1,2}],reverznaIstaQ[{1,2,1}],reverznaIstaQ[{1,2.3,1}]}

Definisati funkciju f na listi realne brojeva koja diže te elemente na kvadrat a onda sabere te kvadrate.

f[x:{_Real..}]:=Total[(x^2)]

Range[-2,2,0.1]

f[Range[-2,2,0.1]]

f[Range[10]]

Evo kako možemo da pišemo funkciju čiji su argumenti kompleksniji oblici

__ (“double blank”) odgovara sekvenci od jednog ili više argumenta. ___ (“triple blank”) odgovara sekvenci od nula i više argumenata. Definišite funkciju koja traži Black i White (u tom redosledu). Ovaj pattern je matchovan kada je Black ispred White šta god drugo da je između, ispred i iza (ili možda ništa). Ako se pronađe takav pattern onda se sve što je između Black i White ponovi tri puta (to je ono što je sa desne strane), a sve drugo se ignoriše.

blackwhite[{___,Black,m___,White,___}]:={m,m,m}

blackwhite[{Purple,Black,Gray,Yellow, Yellow, White,Purple, White}]

A šta će se desiti ako postoji više mogućnosti za matchovanje patterna? Koju će od njih funkcija odabrati?

blackwhite[{Purple,Black, Red, Yellow,Yellow, Purple,White, Black,Gray,Yellow, Yellow, White,Purple, White}]

Primetimo da je funkcija uhvatila prvi pattern!

blackwhite[{Purple,Black, Red, Yellow,Brown, Blue,White, Black,Gray,Yellow, Yellow, White,Purple, White}]

Primetimo da po defoltu  __ i ___ hvataju prvu sekvencu koja odgovara. Umesto toga možete da ga naterate da uhvati najdužu sekvencu koja odgovara ukoliko iskoristite opciju Longest (ili najkraću pomoću Shortest)

blackwhitex[{___,Black,Longest[m___],White,___}]:={m,m,m}

blackwhitex[{Purple,Black, Red, Yellow,White, Black,Gray,Yellow, Yellow, White,Purple, White}]

Sada je cela sekvenca između prvog Black i poslednjeg White ponovljena 3 puta!

Nastavak

Alternative se, kao što smo ranije rekli, predstavljaju kao x|y|z. Taj izraz matchuje x, y ili z. Sa druge strane, x..  (to je x sa dve tačkice posle toga) matchuje proizvoljan broj puta ponovnjen pattern x.

Funkcija bwcut preseca najduže ponavljanje Black ili White i ubacuje Red umesto njih:

bwcut[{a___,Longest[(Black|White)..],b___}]:={{a},Red,{b}}

bwcut[{Purple, Purple,Black,Brown, White,White,Black,Black,Yellow}]

bwcut[{Purple, Purple,Black, White,White,Black,Black,Yellow}]

Pattern x_ je skraćenica od x:_, što znači  “matchuj bilo šta (to jest _) i nazovi rezultat x”. Napravite pattern koji se zove m koji matchuje listu dva para, i onda ih kompletno urami:

grid22[m:{{_,_},{_,_}}]:=Grid[m,Frame->All]

{grid22[{{a,b},{c,d}}],grid22[{{12,34},{56,78}}],grid22[{123,456}],grid22[{{1,2,3},{4,5,6}}]}

Sekvencu Black i White možemo da imenujemo (sa r) i da dužinu sekvence Black ili White koristimo sa desne strane (da je uradimo):

bwcut[{a___,r:Longest[(Black|White)..],b___}]:={{a},Framed[Length[{r}]],{b}}

bwcut[{Purple, Purple,Black, White,White,Black,Black,Yellow}]

Manipulacija sa kvadratnim matricama proizvoljne dimenzije

Napištimo funkciju koja je definisana na kvadratnoj matrici proizvoljne dužine, i koja za datu matricu sabere samu matricu i njenu transponovanu matricu, pa sve to stavi u ram.

Clear[matricaPlusTransponovana]

matricaPlusTransponovana[m_/;SquareMatrixQ[m]]:=Grid[m+m\[Transpose],Frame->All]

{{1,2},{3,1}}+{{1,2},{3,1}}\[Transpose]

matricaPlusTransponovana[{{1,2},{3,1}}]

matricaPlusTransponovana[{{1,2,3},{3,1,2},{4,0,-1}}]

Ali, ovo ne radi, pošto ova matrica nije kvadratna:

matricaPlusTransponovana[{{1,2,3},{3,1,2}}]

Manipulacija sa nizom cifara

Pretpostavimo da imate niz cifrara

niz=RandomInteger[{0,9},100]

Ukoliko se pronađe sekvenca koja počinje brojem 2 i završava brojem 3, to između ponovite dva puta, i obojite crvenim u fontu 20.

Clear[dvatri, dvatrib]

dvatri[{___,2,m___,3,___}]:=Style[#,Red,20]&/@{m,m}

dvatri[niz]

Ako želimo da tome dodamo elemente koje imamo pre i posle m, to možemo postići pomoću ovakve funkcije:

dvatrib[{x___,2,m___,3,y___}]:=Join[{x},Style[#,Red,20]&/@{m,m},{y}]

dvatrib[niz]

Ukoliko želimo, možemo dići elemente iz m na treći stepen pre nego što ih obojimo u crveno (a pri tome ih ne bismo ponavljali dva puta):

dvatric[{x___,2,m___,3,y___}]:=Join[{x},Style[((#)^2),Red,20]&/@{m},{y}]

dvatric[niz]

Više o pravilima transformacija (Transformation rules)

Pravila transformacije izraza (Replace) su mehanizmi preko kojih WL menja izraze. Već smo ih ranije videli, ali sada hoćemo da ih pažljivije obradimo jer su veoma korisni u praksi.  Znamo da kada definišemo funkcije, onda one automatski primene sva pravila koja se na njih odnose i time transformišu izraze. Replacement rules rade to ručno, da tako kažem. Nekad je to važno.

Setimo se da pravilo transformacije ima sledeću formu: ili

oblik-> zamena ili oblik :> zamena.

Prvi tip se zove trenutna zamena a drugi tip je zamena sa zadrškom. Iskazi su tipa ReplaceAll[expr,pattern-> replacement]:

ReplaceAll[x+y,y-> α]

To je puna forma za:

x+y/.y-> α

Glavna razlika sa assignment operatorom jeste su u pitanju lokalne promene varijabli.

y

Primer transformacije

Razmotirmo zamenu

(((x+1+y))^2)/.x+1-> σ

Ovde se prvo izraz na levoj strani izračuna tako da dobijemo (((x+1+y))^2). Onda se izračuna leva strana pravila se izračuna i to na daje x+1. Onda se izračuna desna strana pravila što daje σ. Najzad, oblik x+1, u izrazu koji se transformiše, se zamenjuje sa σ.

Sa druge strane, šta bismo dobili ako probamo sledeće:

(((x-1+2+y))^2)/.x-1-> σ

(((x+1+y))^2)/.x-1-> σ

Sada kada se na levoj strani pravila izračuna x-1, taj oblik ne može da se matchuje u izrazu koji želimo da transformišemo, (((x+1+y))^2). Tako da se na kraju ništa ne desi.

Ono što smo hteli da uradimo bi verovatno bilo, umesto toga, ovo:

(((x+1+y))^2)/.x-> σ+1

Transformacije pomoću -> ili :>

Razmorimo sledeći primer:

{a,a}/.a-> RandomReal[]

Prvo se izračuna izraz sa leve strane i dobijemo {a,a}. Onda se izračuna leva strana pravila i dobijemo a. Najzad, izračunamo desnu stranu pravila i dobijemo neki slučajni broj. Taj broj je dodeljen pravilu. Stoga ćemo imati isti broj za oba a u izrazu {a,a}.

Sa RuleDelayed, desna strana zamene se izračuna tek kada se izvrši zamena. Drugim rečima, ponovo se preračunava svaki put. Kao rezultat, dobijamo:

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

Kada god imamo globalne simbole sa desne strane pravila, dobra ideja je da koristimo delayed replacement :> kako bismo izbegli prethodno assigned globalna vrednost se iskoristi prilikom zamene. Kako da znamo da li je neki simbol globalan?

?a

Ne postoji ograničenje kakav oblik može biti iskorišćen za zamenu. Na primer, listu 3 simbola možemo zameniti sa njihovom sumom ukoliko glavu List zamenimo sa Plus

List[a,b,c]/.List-> Plus

Isto se može uraditi i ovako:

List[a,b,c]/.List:>  Plus

Primeri transformacija matrica

Pretpostavimo da želimo da permutujemo kolonu 2 i kolonu tri u sledećoj matrici:

Clear[f]

mat={{a,b,c},{d,e,f}};

MatrixForm[mat]

matcol=mat/.{col1_,col2_,col3_}:> {col1,col3,col2}

matcol2=matcol/.{col1_,col2_,col3_}:> {col2,col1,col3}

MatrixForm[matcol2]

Ovako permutujemo 1. i 3. kolonu:

matcol=mat/.{col1_,col2_,col3_}:> {col3,col2,col1}

MatrixForm[matcol]

A kako da permutujemo prvi i drugi red?

Map[Reverse,mat]

Reverse[mat]

matrow=mat/.{row1_,row2_}:> {row2,row1}

Još primera transformacija matrica

Pored ReplaceAll možemo koristiti i ReplacePart[expr,m-> val]. To menja deo u poziciji m kojoj dodeljuje vrednost val.

Pretpostavimo da želimo da elemente u matrici mat u kojima su redni brojevi kolone i reda isti zamenimo sa 0. U primeru su ti elementi u poziciji {1,1} i {2,2}.

ReplacePart[mat,{i_,i_}:> 0]

Možemo da zamenimo i element u poziciji {1,2} sa 1.

ReplacePart[mat,{1,2}:> 1]

Kombinujući ta pravima imamo da je:

ReplacePart[mat,{{1,2}:> 1,{i_,i_}:> 0}]//MatrixForm

Lista sa više pravila

Evo kako izgleda kada imamo više pravila (oba pravila se primenjuju samo po jednom ovde):

{a,b,c,b}/.{c:>b,b:>a}

{a,b,c}/.{c:>b,b:>a}

Dakle, c u izrazu se transformiše u b, a b se transformiše u a.

Naći vrednost Log[x y] ukoliko je x jednako 10 a y jednako 20. Koristiti transformacije:

Log[x y]/.{x-> 10, y-> 20}

U funkciji Log[x y] zamenite prvo {x-> (t^2), y-> (t^4)} a onda zamenite t->10. Šta se dobije?

ReplaceAll[Log[x y]/.{x-> (t^2), y-> (t^4)},t->10]

To isto se može predstaviti i ovako:

Log[x y]/.{x-> (t^2), y-> (t^4)}/.t->10

Napravimo pravilo koje će zameniti prostu listu u složenu listu u kojoj je prva podlista originalna lista, a druga podlista je reverzna originalna lista dignuta na kvadrat

{a,b,c,d}/.x_:>  {x,((Reverse[x])^2)}

Ponovljena pravila

U nekim situacijama želimo da primenimo pravila više pura. Razmotrimo prvo sledeći primer:

a b c d/.x_ y_:>x+y

a b c d//.x_ y_:>x+y

Ukoliko nastavimo da ponavljamo pravilo kod izraz ne prestane da se menja, dobićemo:

ReplaceRepeated[a b c d,x_ y_:>x+y]

To ponavljanje dok se ne stigne do fiksne tačke ima kratku oznaku //.

a b c d//.x_ y_:>x+y

Razmotrimo sad listu {a,b,c,d} i nađimo transformaiciju koja je menja u proizvod a b c d

{a,b,c,d}/.{x_,y__}:> x y

{a,b,c,d}//.{x_,y__}:> x y

Počnimo od složene liste

{{a,a,a,a},{a,a},{{b,b,b},{b,b}},{a,a}}

Napravimo funkciju baziranu na pravilu koje će Flatten na prvom nivou. Onda napraviti pravilo koje će raditi kao Flatten.

unNest[{{a,a,a,a},{a,a},{{b,b,b},{b,b}},{a,a}}]

unNest[lis_]:=Map[(#/.{x__}:>x&),lis]

unNest2[lis_]:=Map[(#//.{x__}:>x&),lis]

unNest[{{a,a,a,a},{a,a},{{b,b,b},{b,b}},{a,a}}]

unNest2[{{a,a,a,a},{a,a},{{b,b,b},{b,b}},{a,a}}]

Primena pravila transformacije (Applying transformation rules)

Rules možemo da koristimo za puno različitih stvari. Nađimo srednju vrednost svakog uređenog para u listi i dodajmo je svakom parru:

{{x1,y1},{x2,y2},{x3,y3}}/.{x_,y_}:>{x,y,(x+y)/2}

Saberimo svaki od parova tačaka po komponentama (posebno sabiramo sve prve koordinate, a posebno sve druge):

{{x1,y1},{x2,y2},{x3,y3}}/.{x_,y_,z_}:>x+y+z

Invertuje x i y koorinatu za svaku tačku:

{{x1,y1},{x2,y2},{x3,y3}}/.{x_,y_}:>{y,x}

Ali, šta će se desiti ako probamo sada sledeće?

{{x1,y1},{x2,y2}}/.{x_,y_}:>{y,x}

Zašto to ne radi? Stvar je u tome da po defoltu to je ekvivalentno

{{x1,y1},{x2,y2}}/.{x_List,y_List}:>{y,x}

Naime  {x_,y_} misli su u pitanju dve liste koje treba matchovati pa onda obrće njih. Probajmo umesto toga:

{{x1,y1},{x2,y2}}/.{x_Symbol,y_Symbol}:>{y,x}

Sada pattern traži listu sa simbolima, i to obrće. To je to što smo hteli.

Transformacija grafika

Pretpostavimo da smo napravili plot funkcije Sin[x] od 0 do 2 π. Predstavimo ga zajedno sa svojim odrazom u ogledalu kada x zamenimo sa y i obrnuto:

gr=Plot[Sin[x],{x,0,2 π}];

Show[{gr,gr/.{x_?NumberQ,y_?NumberQ}:>{y,x},Graphics[{Dashed,InfiniteLine[{{0,0},{1,1}}]}]},PlotRange-> All,AspectRatio-> Automatic]

Probajmo to isto sa Cos funkcijom

gr=Plot[Cos[x],{x,0,2 π}];

Show[{gr,gr/.{x_?NumberQ,y_?NumberQ}:>{y,x},Graphics[{Dashed,InfiniteLine[{{0,0},{1,1}}]}]},PlotRange-> All,AspectRatio-> Automatic]

Možemo da napišemo funkciju koja uzima grafik kao argument i transformiše ga na taj način:

grafikOgledalo[grafik_Graphics]:=Show[{grafik,grafik/.{x_?NumberQ,y_?NumberQ}:>{y,x},Graphics[{Dashed,InfiniteLine[{{0,0},{1,1}}]}]},PlotRange-> All,AspectRatio-> Automatic]

grafikOgledalo[Plot[Sin[x],{x,0,2 π}]]

grafikOgledalo[Plot[Cos[x],{x,-2 π,2 π}]]

Brojanje novčića

U SAD postoje sledeći novčići: penny (1 cent), nickle (5c), dime (10 c) i quarter (25 c). Pretpostavimo da imamo neku kolekciju novčića. Izračunaj njihovu ukupnu vrednosti. Prvo napravimo slučajni uzorak novčića koji bi mogli da nam se nađu u džepu. Imamo 50 novčića.

coins=RandomChoice[{p,n,d,q},50]

Pravila

rules=MapThread[RuleDelayed,{{p,n,d,q},{0.01,0.05,0.1,0.25}}]

Evo i funkcije koja broji novčiće

countChange[coins_]:=Total[coins/.{p:>0.01,n:>0.05,d:>0.1,q:>0.25}]

countChange[coins]

Filtriranje podataka

Filtriranje i izdvajanje podatka po nekom kriterijumu. Recimo da želimo da izaberemo samo one podatke koji su između 2 i 5.

data=RandomInteger[8,{30}]

Cases[RandomInteger[8,{30}],x_/;2≤ x≤ 5]

Pretpostavljamo da imamo bazu podataka

data={{"Col1","Col2","Col3","Col4"},{1,61,20,80},{2,17,30,95},{3,31,18,63},{4,24,42,51}};

data//MatrixForm

Želimo da izaberemo one podatke kod kojih je vrednost u poslednjoj koloni veća od 75. Onda hoćemo da predstavimo samo prvu i poslednju kolonu.

Cases[Rest[data],{col1_,__,col4_/;col4>75}:>{col1,col4}]

Ako želimo da tu dodamo i nazive kolona:

data[[1]][[{1,4}]]

Join[{data[[1]][[{1,4}]]},Cases[Rest[data],{col1_,__,col4_/;col4>75}:>{col1,col4}]]//Grid

Izračunati obim trougla

Razmotrimo 3 tačke u ravni, recimo:

pts={{0,0},{4,0},{4,3}};

Kako da nacrtamo trougao koji prolazi kroz te tri tačke koristeći Line? Prvo nam je potrebno da zatvorimo trougao, to jest da ponovimo ponovo početnu tačku:

pts/.{pt1_,ptn__}:> {pt1,ptn,pt1}

Sada možemo da nacrtamo granicu (liniju) trougla:

Graphics[Line[pts/.{pt1_,ptn__}:> {pt1,ptn,pt1}]]

Obim se dobija kao dužina te linije:

ArcLength[Line[pts/.{pt1_,ptn__}:> {pt1,ptn,pt1}]]

Možemo da napravimo i funkciju koja računa obim trougla:

Clear[pts]

perimeter[Triangle[pts:{p1_,p2_,p3_}]]:=ArcLength[Line[pts]/.{pt1_,ptn__}:> {pt1,ptn,pt1}]

perimeter[Triangle[{{0,0},{4,0},{4,3}}]]

Naći koordinate na osnovu kojih je nacrtana linija na grafiku

Pretpostavimo da imamo sledeću grafičku komandu

plot=Graphics[{Red,Thick,Line[{{1,0},{2,1},{3,0},{4,1}}]}]

Na osnovu plota možemo da lako izvučemo koordinate tačaka kroz koje je linija provučena (naravno znamo koje su to tačke, ali je ideja korisna za ono što sledi na narednom slajdu)

Cases[plot,Line[pts:{{_,_}..}]:> pts,Infinity]

Sada možemo i da grafički predstavimo te tačke, plavom bojom i odgovarajućom veličinom:

tacke=Graphics[{Blue,PointSize[0.02],Point[Cases[plot,Line[pts:{{_,_}..}]:> pts,Infinity]]}]

Najzad stavimo na isti grafik i originalnu crvenu liniju i tačke iz kojih je linija napravljena:

Show[plot,tacke]

Naći tačke koje funkcija Plot koristi kada crta grafik funkcije

Razmotrimo:

plot=Plot[Sin[x],{x,0,2 π}];

Uđimo unutar te funkcije da vidimo kako ona stvarno radi (Short na pomaže da output ograničimo na samo 8 prvih članova izraza):

Short[InputForm[plot],20]

Dakle, Plot crta koristeći Line. Izdvojimo sada samo ono su elementi sa Line (prikazujemo samo prvih 5)., Ovde Infinity govori do kog nivoa dubine moramo da idemo kad tražimo da matchujemo oblik (do samog dna).

Short[Cases[plot,Line[{{_,_}..}],Infinity],5]

Ukoliko sa pts:{{_,_}..} označimo oblik tačke koji se ponavlja, možemo lako da izvučemo koordinate koje koristi Plot:

coords=Cases[plot,Line[pts:{{_,_}..}]:> pts,Infinity];

Short[coords,5]

ListPlot[coords]

Vidimo da Plot ima mnogo više tačaka oko tačaka extrema i mnogo manje u drugim delovima. Evo funkcije čiji je argument grafik, a koja crta samo tačke tog grafika:

tackeGrafika[grafik_Graphics]:=ListPlot[Cases[grafik,Line[pts:{{_,_}..}]:> pts,Infinity]]

tackeGrafika[Plot[Cos[x],{x,0,2 π}]]

Sortiranje liste (Sorting of a list)

Sortiranje je jedan od fundamentalnih zadataka u računarstvu. Ideja je da se uzme niz brojeva, na primer, i da se urede po nekom pravilu. Ovde ćemo napraviti pravilo koje uređuje brojeve po uzlaznom redu. Zovemo to pravilo listSort. Da bismo uzeli u obzir prvi i poslednji element koristimo triple blanks ---. To matchuje sekvence od 0 i više elemenata.

listSort={{x___,a_?NumericQ,b_?NumericQ,y___}:> {x,b,a,y}/;b<a};

Izraz koji mora da matchuje pattern {x___,a_?NumericQ,b_NumericQ,y___} jeste lista sa najmanje dva elementa pošto x___ i y___ mogu da se matchuju i sa nula elemenata. Uslov na desnoj strani pravila jeste da kad god je b manje od a, obrnemo redosled a i  b. Napravimo prvo listu slučajnih brojeva.

nums=RandomReal[1,{10}]

Ako primenimo listSort rule jednom to će da uredi kako treba prvi par koji nađe da treba da se invertuje i tu će stati.

nums//.listSort

Da bismo uredili celu listu, moramo to da ponovimo sve dok ne može više ništa da se invertuje. To radimo preko ponovljenog replace:

nums//.listSort

U FullForm to što smo uradili izgleda ovako:

ReplaceRepeated[nums,listSort]

Sada možemo da napišemo funkciju mySort koja uzima listu od najmanje 2 elementa, i onda je sortira po tom pravilu:

Funkcija za sortiranje

mySort[inputlist_List/;Length[inputlist]≥2]:=Module[{listSort={{x___,a_?NumericQ,b_?NumericQ,y___}:> {x,b,a,y}/;b<a}},ReplaceRepeated[inputlist,listSort]]

Evo kako to radi:

mySort[nums]

Ovaj algoritam očito radi, ali je spor. U pitanju je takozvani bubble sort algoritam. Njegova kompleksnost je reda veličine (n^2), gde je n količina brojeva koju treba da sortiramo. Ovako možemo da nađemo Timing za tu operaciju. U slučaju liste od 10 slučajnih brojeva:

Timing[mySort[RandomReal[1,{10}]]]

Prvi deo te liste daje Timing.

First[Timing[mySort[RandomReal[1,{10}]]]]

Sada ćemo napraviti Table sa Timing-om za sortiranje dužine od  50 do 150 (sa korakom 10)

times=Table[First[Timing[mySort[RandomReal[1,{n}]]]],{n,50,150,10}]

Imamo li kvadratnu zavisnosti? Da to ustanovimo fitujmo kvadratnu funkciju:

model=LinearModelFit[times,{x,(x^2)},x]

To je obična regresija.

model["BestFit"]

Sada možemo da prikažemo Timing i ono što predviđa model:

Show[ListPlot[times],Plot[model[t],{t,1,11}],PlotLabel-> model["BestFit"]]

Upoređenje i uopštenje funkcije za sortiranje

Uporedimo to sa timingom za Sort (built-in funkcija)

times1=Table[First[Timing[Sort[RandomReal[1,{n}]]]],{n,100,10000,100}]

Jasno je da je Sort mnogo mnogo brža.

Prethodno smo radi sa funkcijom koja sortira od najmanjeg do najvećeg broja. To će biti defolta opcija. Međutim, možemo malo da je uopštimo ukoliko dodamo još jedan parametar u funkciju, “Reverse” koji određuje da sortiramo od navećeg do najmanjeg broja. Za to je potrebno nešto malo promeniti u prethodnoj funkciji:

mySort[inputlist_List/;Length[inputlist]≥2,"Reverse"]:=Module[{listSort={{x___,a_?NumericQ,b_?NumericQ,y___}:> {x,b,a,y}/;b>a}},ReplaceRepeated[inputlist,listSort]]

Pogledajmo sada definiciju funkcije

?mySort

Vidimo da kad dodamo taj drugi argument, poredak se menja:

mySort[nums]

mySort[nums,"Reverse"]