--- title: "Joonised" author: "Jaagup Kippar" output: html_document --- Kõigepealt katsetasin õpiku 5. peatüki seosekõvera näidet sisseehitatud mtcars-andmestiku peal loess-funktsiooni span-parameetriga (vaikimisi 0.75) tasandasin seosejoone järsemaid jõnkse ```{r} plot(mpg~qsec, data=mtcars, main="Autode kütusekulu ja kiirenduse seos", xlab="Sõidu alustamisel veerand miili läbimise aeg", ylab="Ühe galloni kohta läbitud miilide arv") lines(sort(mtcars$qsec), fitted(loess(mpg~qsec, data=mtcars,span = 0.9))[order(mtcars$qsec)], lwd=3, lty=2) ``` Õpiku näide tööle - liigirikkus katselapil võrrelduna palja maapinna protsendiga konkreetsel katselapil. Lahendamisel selgus, et markdown saab aru, et andmefaile tuleb lugeda samast kataloogist kus on rmd asukoht. Kui tahta aga käske eraldi R-i käsureal katsetada, siis tuleb eraldi määrata kataloog failide sisse lugemiseks. ```{r} #setwd("d:/R/6") Veg <- read.table(file = "Vegetation2.txt", header = TRUE) plot(Veg$BARESOIL, Veg$R) ``` Värvid vastavalt katse aastale. ```{r} plot(Veg$BARESOIL, Veg$R, col=ifelse(Veg$Time>1974, "green", "red"), pch=16, xlab="Palja maapinna protsent", ylab="Liikide arv mõõtlapil", main="Liigirikkus", sub="Rohelised punktid tähistavad uuemaid mõõtmisi") ``` ## Viienda peatüki ülesanne Ülesande lahendamiseks leidsin soovitud nimega ning pealtnäha sobiva sisuga faili https://github.com/hangyan/Code/blob/master/R/RBeginners/RBook/Amphibian_road_Kills.xls Andmed sisse ```{r} andmed=read.table("Amphibian_road_Kills.csv", header=TRUE, sep=";", dec=",") head(andmed) ``` Lihtne joonis ```{r} plot(TOT.N~D.PARK, data=andmed, xlab="Kaugus rahvuspargist (meetrites?)", ylab="Hukkunud loomade arv (aastas?)", main="Loomade hukkumine liikluses") ``` Lisatud seosejoon ```{r} plot(TOT.N~D.PARK, data=andmed, xlab="Kaugus rahvuspargist", ylab="Hukkunud loomade arv", main="Loomade hukkumine liikluses") lines(sort(andmed$D.PARK), fitted(loess(TOT.N~D.PARK, data=andmed))[order(andmed$D.PARK)], lwd=3, lty=2) ``` Oliivisalude arv mõõdetaval alal ```{r} plot(TOT.N~D.PARK, data=andmed, cex=OLIVE, main="Loomade hukkumine liikluses", sub="Ringi suurus näitab oliivisalude hulka piirkonnas", xlab="Kaugus rahvuspargist", ylab="Hukkunud loomade arv") ``` Ringi läbimõõdu teen võrdeliseks ruutjuurega oliivisalude arvust. Kuna pindala on võrdeline raadiuse ruuduga, siis võiks võrdlus usutavam olla. ```{r} plot(TOT.N~D.PARK, data=andmed, cex=sqrt(OLIVE), main="Loomade hukkumine liikluses", sub="Ringi pindala näitab oliivisalude hulka piirkonnas", xlab="Kaugus rahvuspargist", ylab="Hukkunud loomade arv") ``` Kuna erinevused võivad olla väga suured, siis kasutan läbijagamise asemel logaritmi võtmist. Et pisikesed ringid ka näha oleksid, suurendan lisaks kõikide läbimõõtu ühe ühiku võrra. ```{r} plot(TOT.N~D.PARK, data=andmed, cex=log(OLIVE)+1, main="Loomade hukkumine liikluses", sub="Ringi läbimõõt - oliivisalude hulk piirkonnas logaritmina", xlab="Kaugus rahvuspargist", ylab="Hukkunud loomade arv") ``` # Seitsmes peatükk ## Sektordiagramm 7/1 Andmed sisse. Andmestikuks linnugripi juhtumite arv riigiti ja aastati. Indoneesia taga oli failis kahtlane sümbol, mille lihtsalt notepadiga kustutasin ```{r} linnud=read.table("BirdFluDeaths.txt", header=TRUE) linnud ``` Aastaid pole mõtet kokku summeerida, riikide kaupa linnugripi juhtumite arve aga küll. ```{r} colSums(linnud[, 2:ncol(linnud)]) ``` Õnnelikul kombel suudab pie-käsklus sarnasel kujul andmed ka kohe sisse lugeda. ```{r} pie(colSums(linnud[, 2:ncol(linnud)])) ``` Omaette nuputamist vajab, kuidas väikeste kogustega riigid joonisel üksteise peale ei läheks. Üheks võimaluseks paistab olema alles jätta piisvalt suurte kogustega riigid ```{r} riigikogused=colSums(linnud[, 2:ncol(linnud)]) pie(riigikogused[riigikogused>10], main="Linnugripi juhtumite arv") ``` Väiksemad kogused saab ühendada ```{r} riigikogused2=riigikogused[riigikogused>10] riigikogused2["muu"]=sum(riigikogused[riigikogused<=10]) riigikogused2 pie(riigikogused2, main="Linnugripi juhtumite arv 2003-2008", labels=paste(names(riigikogused2), '-', riigikogused2)) ``` Sorteerituna ```{r} riigikogused2=sort(riigikogused2) pie(riigikogused2, clockwise=TRUE, init.angle=0) ``` Sildid Tühi plats alla, joonistades jäetakse nurgad meelde ning nende järgi tõstetakse paika sildid. Ei leidnud joone tõmbamise käsku sildi ja sektori vahele. ```{r} library(plotrix) riigikogused=riigikogused[order(riigikogused)] plot(1:5, type="n", axes=FALSE, xlab="", ylab="") nurgad=floating.pie(3, 3, riigikogused) pie.labels(3, 3, nurgad, names(riigikogused), radius=1.3, minangle=0.08) ``` Aastati. Aastanumbrid vastavate summade pealkirjadeks. ```{r} kogused=rowSums(linnud[, 2:ncol(linnud)]) names(kogused)=linnud$Year pie(kogused) ``` Kolmemõõtmeline joonis ```{r} pie3D(kogused, labels=names(kogused), explode=0.05) ``` ## Tulpdiagramm ### Tulpdiagrammid mtcars tulpade keskmiste ja standardhälvete kohta ```{r} v=sapply(mtcars, FUN=function(x){c(keskmine=mean(x), halve=sd(x))}) v barplot(v, beside=TRUE) ``` Taimede andmed 7/2 ```{r} Veg <- read.table(file = "Vegetation2.txt", header = TRUE) head(Veg) ``` Keskmine liikide arv piirkonniti ```{r} tapply(Veg$R, Veg$Transect, FUN=mean) ``` Sama joonisena ```{r} barplot(tapply(Veg$R, Veg$Transect, FUN=mean), xlab="Piirkonna number", ylab="Liikide arv", main="Keskmine liikide arv piirkonniti") ``` Keskmine, standardhälve ning standardviga piirkondade kaupa Standardviga on keskväärtuse hinnangu standardhälve, arvutatakse väärtuste standardhälve jagatuna ruutjuurega väärtuste arvust. tapply andis mitme vastusfunktsiooni küsimisel tagasi listi ning sellise tulemuse "kandiliseks" (sedakorda maatriksiks) saamiseks ei leidnud ma muud lahendust, kui et tekkinud list do.call käsu abil elementidega cbind-funktsioonile ette anda. Natuke ümbertnurga-tegemine tundub, aga paistab toimima. ```{r} arvutused=do.call(cbind, tapply(Veg$R, Veg$Transect, function(r){c(keskmine=mean(r), standardhalve=sd(r), standardviga=sd(r)/sqrt(nrow(Veg)))})) arvutused class(arvutused) ``` Tulemused koos legendiga, tulbad kõrvuti. Ehkki erineva sisuga tulbad, siis siiski sama mõõtühikuga (liikide arv katselapil) ning peaks tohtima samale joonisele kõrvuti panna. ```{r} barplot(arvutused, beside=TRUE, legend=TRUE, xlab="piirkond", ylab="Liikide arv katselapil") ``` Kui standardhälve keskmisele "selga" istutada, siis see võiks näidata, kui palju väärtused keskmisest (ülespoole) ühe standardhälbe jagu kõiguvad. ```{r} barplot(arvutused[c("keskmine", "standardhalve"), ]) ``` Keskmised koos andmestikku iseloomustavate standardhälbe jagu kõikumistega. ```{r} bp=barplot(arvutused["keskmine",] , ylim=c(0, max(arvutused["keskmine",]+arvutused["standardhalve",]))) arrows(bp, arvutused["keskmine",], bp, arvutused["keskmine",]+arvutused["standardhalve",]) ``` Keskmised koos keskmise veahinnangut näitava standardveaga. Piirang ylim vajalik, et veapiirid ka joonisele ära mahukusid. Kuigi peaks veidi veel vist lisaks panema, sest soovitatakse, et skaala oleks näidatavatest andmetest pigem pikem. ```{r} bp=barplot(arvutused["keskmine",] , ylim=c(0, max(arvutused["keskmine",]+arvutused["standardviga",]))) arrows(bp, arvutused["keskmine",], bp, arvutused["keskmine",]+arvutused["standardviga",], angle=90) ``` Stripcharti abil samad andmed piirkonniti ```{r} stripchart(Veg$R~Veg$Transect, method="jitter", vert=TRUE, pch=1, xlab="piirkond", ylab="liikide arv", main="Liikide arv katselapil piirkonniti") ``` Võrreldes eelmisega juures hinnanguline keskväärtus ning selle ühe standardhälbe (68% usaldusnivoo) kaugused kõikumispiirid. Noolekäskluse abil siis loodud jooned mõlemas suunas ```{r} stripchart(Veg$R~Veg$Transect, method="jitter", vert=TRUE, pch=1, xlab="piirkond", ylab="Liikide arv", main="Liikide arv katselapil piirkonniti", sub="Joonte vahel on iga piirkonna keskväärtuse vahemik usaldusnivool 68% (SE)") points(1:ncol(arvutused), arvutused["keskmine",], pch=16, cex=1.2) arrows(1:ncol(arvutused), arvutused["keskmine",], 1:ncol(arvutused), arvutused["keskmine",]+arvutused["standardviga",], angle=90, length=0.1) arrows(1:ncol(arvutused), arvutused["keskmine",], 1:ncol(arvutused), arvutused["keskmine",]-arvutused["standardviga",], angle=90, length=0.1) ``` ## Karp ja vurrud (pt 7, ül 3) Liikide arvu jaotus kõigi katselappide peale kokku ```{r} boxplot(Veg$R) ``` Liikide arvu jaotus katselappidel piirkondade kaupa ```{r} boxplot(Veg$R~Veg$Transect) ``` ## Tursa parasiidid 7/4 ```{r} parasite=read.table("CodParasite.txt", header=TRUE) head(parasite) ``` Parasiitide arv teiste tunnuste kaupa ```{r} boxplot(parasite$Intensity~parasite$Area, main="Parasiitide arv vastavalt piirkonnale") boxplot(parasite$Intensity~parasite$Stage, main="Parasiitide arv vastavalt arengujärgule") boxplot(parasite$Intensity~parasite$Sex, main="Parasiitide arv vastavalt soole") boxplot(parasite$Intensity~parasite$Year, main="Parasiitide arv vastavalt aastale") ``` Parasiitide arv aastate ja soo kaupa ```{r} boxplot(parasite$Intensity~parasite$Year*parasite$Sex) ``` Parasiitide arv aastate ja piirkonna kaupa, tulbade nimed parema lugemise huvides keeratud. Neljandas piirkonnas paistab suhteliselt laiemas skaalas tulemusi jaguma. 2001. aastal lihstalt nõnda palju nullilisi tulemusi, et see ka mediaani madalale kisub. ```{r} boxplot(parasite$Intensity~parasite$Area*parasite$Year, las=2) ``` Kuna paljudel kaladel pole parasiite, siis eraldi vaatlus selle kohta, kuidas jagunevad olemasolevad parasiidid. ```{r} parasiitidega=parasite[parasite$Intensity>0, ] par(mfrow=c(2, 2)) boxplot(parasiitidega$Intensity~parasiitidega$Area, main="Piirkond", ylab="Parasiitide arv") boxplot(parasiitidega$Intensity~parasiitidega$Stage, main="Arengujärk") boxplot(parasiitidega$Intensity~parasiitidega$Sex, main="Sugu") boxplot(parasiitidega$Intensity~parasiitidega$Year, main="Aasta") par(mfrow=c(1, 1)) ``` Samas juurde võrdlus, et milliste tunnuste järgi leiab kui palju puuduvate parasiitidega kalu ```{r} par(mfrow=c(2, 2)) for(tulp in c("Area", "Stage", "Sex", "Year")) barplot(table(parasite$Intensity==0, parasite[[tulp]]), main=tulp, legend=c("No parasites", "Parasites")) par(mfrow=c(1, 1)) ``` ## Kullid ja Cleveland dotplot 7/5 ```{r} kullid=read.table("Owls.txt", header=TRUE) head(kullid) ``` Linnuvanemate pesale saabumise aeg. Iga täpike tähistab ühte katset. ```{r} dotchart(kullid$ArrivalTime, xlab="Saabumise aeg", ylab="Katse number", sub="Kellaajad üle 24 tähistavad uut päeva", main="Kullivanemate pesale saabumise ajad") ``` Tulemused grupeeritud toidu kättesaadavuse põhjal. Silma järgi vaadates märkab, et priipärast vaba toidu puhul on mõni kiirem kohalejõudmine juures. Kas aga see andmestiku hulgas statistiliselt oluline on, see eraldi küsimus. ```{r} dotchart(kullid$ArrivalTime, groups=kullid$FoodTreatment) ``` Paistab, et toiduküllus loeti vaikimisi juba faktorina sisse, nii et eraldi tüübimuundust pole vaja. ```{r} class(kullid$FoodTreatment) ``` Häälitsuste arv poja kohta ```{r} dotchart(kullid$SiblingNegotiation) ``` Pesa ja öö kombinatsioon uueks tulbaks. Iga pesa oli ühe öö piiratud toiduvalikuga (Deprived) ning küllusliku toiduvalikuga (Satiated) Nõnda paljude pesade puhul graafik veidi tihedavõitu. ```{r fig.width=9, fig.height=11} kullid$pesaoo=paste(kullid$Nest, kullid$FoodTreatment, sep="") head(kullid$pesaoo) dotchart(kullid$ArrivalTime, groups=factor(kullid$pesaoo), cex=0.5) ``` Tursaparasiitide andmed 7/6 ```{r} parasite=read.table("CodParasite.txt", header=TRUE) head(parasite) ``` Andmed vastavalt mõõtmisele ```{r} dotchart(parasite$Intensity, main="Tursa parasiitide arv mõõtmisel", xlab="Parasiitide arv", ylab="Katse") ``` Parasiitide hulk aasta, soo asukoha ning aregujärgu kaupa ```{r} dotchart(parasite$Intensity, groups=factor(parasite$Year)) dotchart(parasite$Intensity, groups=factor(parasite$Sex)) dotchart(parasite$Intensity, groups=factor(parasite$Area)) dotchart(parasite$Intensity, groups=factor(parasite$Stage)) ``` Parasiitide leidumine ja mõõduvõtmise sügavused (ühik?) ```{r} dotchart(parasite$Depth, groups=factor(parasite$Prevalence)) ``` # 7/7 Skaala ümberarvutus, siltide määramine skaalal Kümnendlogaritm hoolitsemaks, et suured väärtused liialt suured ei paistaks ja väiksed vahed näha oleksid. Algandmetele +1, kuna nullist ei anna logaritmi võtta. ```{r} kullid$logneg=log10(1+kullid$SiblingNegotiation) ``` Joonis ilma algsete telgedeta, pärast teljed sobivas suuruses juurde. Et näha oleks ka kaugemaid osi ja telgede jätkuvust, said teljed tehtud veidi pikemad, kui andmete oma vahemik. ```{r} plot(kullid$logneg~kullid$ArrivalTime, axes=FALSE, xlab="Pesale jõudmise aeg", ylab="Häälitsuste arv linnupoja kohta", main="Logaritmilisel skaalal häälitsuste arv linnuvanema saabumisel \nvastavalt kellaajale") axis(1, at=c(20, 22, 24, 26, 28, 30), labels=c("20.00", "22.00", "0.00", "02.00", "04.00", "06.00")) vaartused=seq(0, 2, 0.3) sildid=round(10^vaartused-1, 1) sildid axis(2, at=vaartused, labels=sildid) ``` # 7/8 Isaste ja emaste kullide toitmisaja erinevus. Kummagi kohta algul eraldi alaandmestik. Esimesed punktid plot-käsuga ekraanile, ülejäänud hiljem points-käsuga. Loess aitab paindliku lähendjoone teha. ```{r} #kullid$logneg=log10(1+kullid$SiblingNegotiation) isakullid=kullid[kullid$SexParent=="Male",] emakullid=kullid[kullid$SexParent=="Female",] plot(isakullid$logneg~isakullid$ArrivalTime, axes=FALSE, xlab="Pesale jõudmise aeg", ylab="Häälitsuste arv linnupoja kohta", main="Logaritmilisel skaalal häälitsuste arv linnuvanema saabumisel \nvastavalt kellaajale", col="blue") points(emakullid$logneg~emakullid$ArrivalTime, col="pink") lines(sort(isakullid$ArrivalTime), fitted(loess(logneg~ArrivalTime, data=isakullid))[order(isakullid$ArrivalTime)], lwd=3, lty=2, col="blue") lines(sort(emakullid$ArrivalTime), fitted(loess(logneg~ArrivalTime, data=emakullid))[order(emakullid$ArrivalTime)], lwd=3, lty=2, col="pink") axis(1, at=c(20, 22, 24, 26, 28, 30), labels=c("20.00", "22.00", "0.00", "02.00", "04.00", "06.00")) vaartused=seq(0, 2, 0.3) sildid=round(10^vaartused-1, 1) sildid axis(2, at=vaartused, labels=sildid) legend("topright", c("isane", "emane"), fill=c("blue", "pink")) ``` Samad arvutused, ainult, et eristajaks on toiduküllus. Ülesandes küsiti ka ööde kaupa graafikut, aga seda suutnud eristada, kuna ei suutnud andmetest välja lugeda, milline pesa oli esimesel ööl toidukülluses, milline teisel. ```{r} head(kullid) vahetoitu=kullid[kullid$FoodTreatment=="Deprived",] paljutoitu=kullid[kullid$FoodTreatment=="Satiated",] toonid=c("gray", "red") plot(vahetoitu$logneg~vahetoitu$ArrivalTime, axes=FALSE, xlab="Pesale jõudmise aeg", ylab="Häälitsuste arv linnupoja kohta", main="Logaritmilisel skaalal häälitsuste arv linnuvanema saabumisel \nvastavalt kellaajale", col=toonid[1]) points(paljutoitu$logneg~paljutoitu$ArrivalTime, col=toonid[2]) lines(sort(vahetoitu$ArrivalTime), fitted(loess(logneg~ArrivalTime, data=vahetoitu))[order(vahetoitu$ArrivalTime)], lwd=3, lty=2, col=toonid[1]) lines(sort(paljutoitu$ArrivalTime), fitted(loess(logneg~ArrivalTime, data=paljutoitu))[order(paljutoitu$ArrivalTime)], lwd=3, lty=2, col=toonid[2]) axis(1, at=c(20, 22, 24, 26, 28, 30), labels=c("20.00", "22.00", "0.00", "02.00", "04.00", "06.00")) vaartused=seq(0, 2, 0.3) sildid=round(10^vaartused-1, 1) sildid axis(2, at=vaartused, labels=sildid) legend("topright", c("Vähe toitu", "Palju toitu"), fill=toonid) # öö määramisega raskused ``` ## 7/9 Paarijooniste loomine Ilmaandmed paistavad olema tulpades 10-21 ```{r} head(Veg) pairs(Veg[, 10:21]) ``` Korrelatsioonide funktsioon õpiku lähtekoodist. Paistab, et suviste päevade maksimumtemperatuur on tugevas korrelatsioonis enamike muude temperatuuridega. Tundub, et kohustuslikud parameetrid külge pandaval funktsioonil on x ja y. ```{r} panel.cor <- function(x, y, digits=2, prefix="", cex.cor) { usr <- par("usr"); on.exit(par(usr)) par(usr = c(0, 1, 0, 1)) r <- abs(cor(x, y)) txt <- format(c(r, 0.123456789), digits=digits)[1] txt <- paste(prefix, txt, sep="") if(missing(cex.cor)) cex <- 0.8/strwidth(txt) text(0.5, 0.5, txt, cex = cex * r) } ``` Funktsiooni käivitamine. Diagonaalist allpool olevate lahtrite puhul käivitatakse funktsioon, mis ette antud parameetrile lower.panel ```{r} pairs(Veg[, 10:21],lower.panel=panel.cor) ``` Omaloodud funktsioon. Kuvatakse tulpade keskmiste suhe. ```{r} panel.f1 <- function(x, y){ usr <- par("usr"); on.exit(par(usr)) par(usr = c(0, 1, 0, 1)) text(0.5, 0.5, round(mean(x)/mean(y), 1)) } ``` Teine funktsioon, mis katsetab joonistusvõimalusi ```{r} panel.f2 <- function(x, y, col = par("col")){ #points(x, y, col=col) #col vajalik, et värv kaasa tuleks ja punktid näha oleks, saab ka otse määrata abline(lm(y~x)) abline(v=0) abline(h=0) } ``` Tulemus lehel nähtavaks ```{r} pairs(Veg[, 10:21],lower.panel=panel.f1, upper.panel=panel.f2) ``` # 7/10 Kõigepealt tavaline joonis näitamaks liikide arvu ja vaba pinna seost ```{r} plot(R~BARESOIL, data=Veg) ``` Sama joonis piirkondade kaupa ```{r} coplot(R~BARESOIL | Transect, data=Veg) ``` Joonis täiendatud funktsiooniga - lisatud seosejoon ```{r} coplot(R~BARESOIL | Transect, data=Veg, panel=function(x, y, ...){ points(x, y, ...) abline(lm(y~x)) }) ``` Pideva tunnuse juures coplot. Andmevahemikud osalt kattuvad ```{r} coplot(R~BARESOIL | SumTmax, data=Veg) ``` Jaotuste arv suurendatud ```{r} coplot(R~BARESOIL | SumTmax, data=Veg,number = 9) ``` --- # Õpilaste andmed Juba tuttavamaks saanud õpilaste andmete puhul püüan välja tuua seose õpilase isa ja ema ameti vahel. Kuidas ametid üldse jaotuvad, kuidas nad koos käivad ning milliseid mooduseid naljalt koos ei leia. Andmed sisse ```{r} andmed=read.table("student-mat.csv", header=TRUE, sep=";") ``` Ametite koosesinemiste tabel. ```{r} tabel=as.data.frame.matrix(table(andmed$Mjob, andmed$Fjob)) tabel ameteid=length(tabel) ``` Tulbad eestikeelseteks. ```{r} names(tabel)=c("kodune", "meedik", "muu", "teenindaja", "õpetaja") row.names(tabel)=names(tabel) tabel ``` Kui suur osa lapsevanematest töötab ühise ala peal? ```{r} sum(diag(as.matrix(tabel)))/sum(tabel) ``` Protsentides on see `r round(100*sum(diag(as.matrix(tabel)))/sum(tabel))` % Samal alal töötamine ameti kaupa. Mõnevõrra segadust tekitab arvatavalt seestpoolt kirju "muu" ```{r} diag(as.matrix(tabel))/colSums(tabel) ``` Samad tulemused protsentidena ```{r} round(100*diag(as.matrix(tabel))/colSums(tabel)) ``` Summad rea kaupa ning sealtkaudu emade ametid. ```{r} tabel$reasumma=rowSums(tabel) emadeAmetid=tabel$reasumma names(emadeAmetid)=names(tabel)[1:ameteid] barplot(rev(sort(emadeAmetid)), main="Emade ametid") ``` Summad veergude kaupa ning sealt isade ametid. Selgus, et lihtsaimaks mooduseks nimetusi koos väärtustega hoida ja liigutada oli teha numeric-muutuja koos väärtuste ja nimedega. Numeric on vist vector-tüübi alamliik. Tabelile veerusummadega rida juurde ```{r} tabel=rbind(tabel, colSums(tabel)) row.names(tabel)[length(row.names(tabel))]="veerusumma" ``` Viimase rea võimaldas kätte saada tail-käsk ```{r} isadeAmetid=as.numeric(tail(tabel, 1)[1:ameteid]) names(isadeAmetid)=names(emadeAmetid) ``` Barplot-käsklus kippus skaala tegema lühema kui kõrgeim tulp. Kairi Osula väidab, et see on vale ja ebaviisakas. Skaala pikendamiseks ei leidnud esimese hooga paremat moodust, kui maksimumväärtusele veidi otsa panna. ```{r} barplot(rev(sort(isadeAmetid)), main="Isade ametid", ylim=c(0, max(isadeAmetid)*1.3)) ``` Kokku saadud tabeli anmed. ```{r} tabel ``` Järgmisena arvutan ametikombinatsioonide teoreetilised sagedused - vastava reasumma ja veerusumma korrutis jagatuna inimeste üldarvuga. Ehk kuidas jaguneksid ametipaarid, kui vanemate ametid omavahel ei sõltu. ```{r} teortabel=tabel for(rida in 1:5){ for(veerg in 1:5){ teortabel[rida, veerg]=teortabel[rida, 6]*teortabel[6, veerg]/teortabel[6, 6] } } teortabel ``` Kolmandasse tabelisse tuleb kahe eelmise vahe jagatud vastava teoreetilise sagedusega. Erinevalt hii-ruudu arvutamisest ei võta ma erinevust ruutu, sest soovin märki säilitada. ```{r} vahetabel=round((tabel-teortabel)/teortabel, 2)[1:5, 1:5] vahetabel ``` Arvude seast võimalik leida kombinatsioonid, mis esinevad tunduvalt harvemini kui need juhuslikuna tuleksid. Order-käsklus annab kohad järjekorranumbri järgi, kusjuures ennem liigutakse mööda veergusid ja pärast mööda ridu. Miinus üks selleks, et pärast jäägi ja täisosa abil saaks mugavasti taas rea ja veeru välja arvutada - vastavat eraldi funktsiooni selle tarbeks ei leidnud. ```{r} harvemad=order(vahetabel)[1:4]-1 harvemad ``` Harvemad kombinatsioonid tabelina ```{r} kombinatsioonid=cbind(ema=row.names(vahetabel)[1 +harvemad %% nrow(vahetabel)], isa=names(vahetabel)[1+harvemad %/% ncol(vahetabel)]) kombinatsioonid ``` Andmed automaatse Markdowni tabelina ```{r results="asis"} library(knitr) kable(kombinatsioonid) ``` Järjestatud ema ameti põhjal isa ametite järjestus. RStudio suutis joonise välja teha, kuid Linuxi käsureal töötav rmarkdown::render andis veateate ja teatas, et loodav joonis on liiga suur juhul, kui eraldi mõõtmeid ei määranud. Etteantud suurustega aga töötas. ```{r fig.width=7, fig.height=9} par(mfrow=c(5, 1), oma=c(0, 0, 2, 0)) for(rida in rev(order(tabel$reasumma[1:ameteid]))){ barplot(unlist(vahetabel[rida, order(-vahetabel[rida, ])]), main=names(tabel)[rida], axes=FALSE) } title("Ametite järjestused. Ema amet real, vastavad isa ametid tulpadena", outer=TRUE) par(mfrow=c(1, 1)) ``` Teise vanema ametite järjestus. ```{r fig.width=7, fig.height=9} par(mfrow=c(5, 2)) for(nr in 1:5){ barplot(unlist(vahetabel[nr, order(-vahetabel[nr, ])]), main=paste("ema", names(tabel)[nr]), axes=FALSE, las=2, ylab="isa") abi=vahetabel[, nr] names(abi)=names(vahetabel) barplot(rev(sort(abi)), main=paste("isa", names(tabel)[nr]), axes=FALSE, las=2, ylab="ema") } par(mfrow=c(1, 1)) ``` ```{r} ```{r} ``` ```{r} ```