Funktsioonid

Geomeetriline keskmine

Omavahelise kokkukorrutamise tarbeks õnnestus leida funktsioon prod.

gm1 <- function(x){
  prod(x)^(1/length(x)) 
}
arvud=c(4, 9)
gm1(arvud)
## [1] 6
arvud2=c(1, 2, 32)
gm1(arvud2)
## [1] 4

Kokku korrutamine konspektis mainitud Recall-i abil

kokkukorrutus <- function(x) if(length(x)>1) Recall(c(x[1]*x[2], x[-(1:2)])) else x
kokkukorrutus(arvud)
## [1] 36

Astendustehte kasutamine nimelise funktsioonina

gm2 <- function(x){
  "^"(kokkukorrutus(x), 1.0/length(x))
}
gm2(arvud2)
## [1] 4

Kokkukorrutus for-tsükli abil

gm3 <- function(x){
  puhver=1
  for(arv in x){
    puhver<-puhver*arv
  }
  puhver^(1/length(x))
}
gm3(arvud2)
## [1] 4

Reduce-funktsiooni proov korrutise leidmiseks

Reduce("*", arvud2)
## [1] 64

Keskmise ja standardhälbe leidmine

analyys1 <- function(x){
  vastus=c(mean(x), sd(x))
  names(vastus)=c("keskmine", "standardhalve")
  vastus
}

analyys1(c(3, 4, 6, 5))
##      keskmine standardhalve 
##      4.500000      1.290994

Puuduvate väärtustega jäädakse esialgu hätta

analyys1(c(3, 4, 6, 5, NA))
##      keskmine standardhalve 
##            NA            NA

Puuduvate väärtuste ning komakohtade arvu määramine parameetrite kaudu. Võimalus laduda arve otse väärtuste juurde. Vektoriks tegemine paistab, et võimaldab sisendisse väärtusi segiläbi anda.

Omamoodi harjumatu, et ka väljundvektoris (mitte listis) võivad vastuselementidel olla nimed - aga samas nõnda mugav tulemusi vaadata.

analyys2 <- function(..., na.rm=TRUE, komakohti=20){
  x=c(...)
  vastus=c(round(mean(x, na.rm=na.rm), komakohti), 
           round(sd(x, na.rm=na.rm), komakohti))
  names(vastus)=c("keskmine", "standardhalve")
  vastus
}

analyys2(3, 4, 6, 5)
##      keskmine standardhalve 
##      4.500000      1.290994
analyys2(c(3, 4, 6, 5), 2, 3)
##      keskmine standardhalve 
##      3.833333      1.471960
analyys2(c(3, 4, 6, 5), 2, 3, komakohti=2)
##      keskmine standardhalve 
##          3.83          1.47
analyys2(3, 4, 6, 5, NA)
##      keskmine standardhalve 
##      4.500000      1.290994
analyys2(3, 4, 6, 5, NA, na.rm=FALSE)
##      keskmine standardhalve 
##            NA            NA

Mündi viskamise funktsioon

mynt1<-function(kogus){
  sample(c("KULL", "KIRI"), kogus, replace=TRUE)
}
mynt1(10)
##  [1] "KIRI" "KULL" "KIRI" "KULL" "KIRI" "KULL" "KIRI" "KULL" "KULL" "KULL"

Andmed sagedustabelina

mynt2<-function(kogus){
  table(mynt1(kogus))
}
mynt2(10)
## 
## KIRI KULL 
##    6    4

Funktsioon rle näitab järjest, mitu korda millist tulemust tuli. Et parasjagu soovitakse vaid suurimat järjestikkust pikkust ning pole tähtis, kumb mündi külg sellega oli, siis piisab suurima väärtuse leidmisest.

mynt3<-function(kogus){ 
   max(rle(mynt1(kogus))$lengths)
}
mynt3(10)
## [1] 5

Funktsioonide töökiirused ja kõlbulikud vahemikud

Rekursiivne väljakutse saab tuhandega hakkama, kuid edasi läheb raskeks

summa1 <- function(v) if(length(v)>1) Recall(c(v[1]+v[2], v[-(1:2)])) else v
summa1(1:1000)
## [1] 500500
system.time(summa1(1:1000))
##    user  system elapsed 
##    0.02    0.00    0.02
summa1(1:10000)
## Error: evaluation nested too deeply: infinite recursion / options(expressions=)?
system.time(summa1(1:10000))
## Error: evaluation nested too deeply: infinite recursion / options(expressions=)?
## Timing stopped at: 0.2 0 0.2

Plussmärkidega ühendamine kannatab natukene rohkem

summa2 <- function(v) Reduce("+", v)
summa2(1:1000)
## [1] 500500
system.time(summa2(1:1000))
##    user  system elapsed 
##       0       0       0
summa2(1:10000)
## [1] 50005000
system.time(summa2(1:10000))
##    user  system elapsed 
##       0       0       0
summa2(1:100000)
## Warning in f(init, x[[i]]): NAs produced by integer overflow
## [1] NA
system.time(summa2(1:100000))
## Warning in f(init, x[[i]]): NAs produced by integer overflow
##    user  system elapsed 
##    0.07    0.00    0.06

Tsükliga on veel kümme miljonit täiesti arvutatav

summa3 <- function(v) {
  summa <- 0
  for(i in 1:length(v)) summa <- summa + v[i]
  summa
  # tulemuse tagastamine, sama, mis return(summa)
}

summa3(1:1000)
## [1] 500500
system.time(summa3(1:1000))
##    user  system elapsed 
##       0       0       0
summa3(1:10000)
## [1] 50005000
system.time(summa3(1:10000))
##    user  system elapsed 
##    0.01    0.00    0.01
summa3(1:100000)
## [1] 5000050000
system.time(summa3(1:100000))
##    user  system elapsed 
##    0.06    0.00    0.07
summa3(1:1000000)
## [1] 500000500000
system.time(summa3(1:1000000))
##    user  system elapsed 
##    0.53    0.00    0.53
summa3(1:10000000)
## [1] 5e+13
system.time(summa3(1:10000000))
##    user  system elapsed 
##    5.24    0.00    5.25

Igakord vektori ümber kopeerimine paistab aeganõudev olema

summa4 <- function(v) {
  summa <- 0
  repeat{
    summa <- summa + v[1]
    v <- v[-1]
    if(length(v) == 0) break
  }
  summa
}
summa4(1:10000)
## [1] 50005000
system.time(summa4(1:10000))
##    user  system elapsed 
##    0.34    0.02    0.36
summa4(1:100000)
## [1] 5000050000
system.time(summa4(1:100000))
##    user  system elapsed 
##   45.17    0.00   45.65

Seda sõltumata kasutatavast korduslausest

summa5 <- function(v) {
  summa <- 0
  while(length(v)>0){
    summa <- summa + v[1]
    v <- v[-1]
  }
  summa
}
summa5(1:10000)
## [1] 50005000
system.time(summa5(1:10000))
##    user  system elapsed 
##    0.40    0.00    0.41
summa5(1:100000)
## [1] 5000050000
system.time(summa5(1:100000))
##    user  system elapsed 
##   43.70    0.00   43.85

Valmisstringi loomine toimib ka vaid lühemate lahenduste korral

summa6 <- function(v) {
  txt <- paste(v, collapse="+")
  eval(parse(text=txt))
}
summa6(1:1000)
## [1] 500500
system.time(summa6(1:1000))
##    user  system elapsed 
##       0       0       0
summa6(1:10000)
## Error: evaluation nested too deeply: infinite recursion / options(expressions=)?
system.time(summa6(1:10000))
## Error: evaluation nested too deeply: infinite recursion / options(expressions=)?
## Timing stopped at: 0.01 0 0.01

Ametlik funktsioon kohandatud ka suuremate koguste tarbeks, sada miljonit veel täiesti “söödav”

mean(1:1000)
## [1] 500.5
system.time(mean(1:1000))
##    user  system elapsed 
##       0       0       0
mean(1:10000)
## [1] 5000.5
system.time(mean(1:10000))
##    user  system elapsed 
##       0       0       0
mean(1:100000)
## [1] 50000.5
system.time(mean(1:100000))
##    user  system elapsed 
##       0       0       0
mean(1:1000000)
## [1] 500000.5
system.time(mean(1:1000000))
##    user  system elapsed 
##       0       0       0
mean(1:10000000)
## [1] 5e+06
system.time(mean(1:10000000))
##    user  system elapsed 
##    0.06    0.00    0.06
mean(1:100000000)
## [1] 5e+07
system.time(mean(1:100000000))
##    user  system elapsed 
##    0.17    0.11    0.28
#mean(1:1000000000) #miljard
#system.time(mean(1:1000000000))
#Error: cannot allocate vector of size 3.7 Gb
#In addition: Warning messages:
#1: In mean(1:1e+09) :
#  Reached total allocation of 3792Mb: see #help(memory.size)

Vektorite summa funktsioon

Tühja vektori loomiseks olen näinud mitmesuguseid trikke. Nullide rida tundub loogiline. Samas tundub, et olemasolevasse vektorisse saab vajadusel elemente ka juurde “pressida”.

veksum1 <- function(a, b){
  if(length(a)!=length(b)){
    stop("vektorid on erineva pikkusega")
  }
  vc=rep(0, length(a))
  for(i in 1:length(a)){
    vc[i]=a[i]+b[i]
  }
  vc
}

veksum1(c(2, 3), c(3, 4, 5))
## Error in veksum1(c(2, 3), c(3, 4, 5)): vektorid on erineva pikkusega
veksum1(c(2, 3, 4), c(3, 4, 5))
## [1] 5 7 9

Sama sapply abil

veksum2 <- function(a, b){
  if(length(a)!=length(b)){
    stop("vektorid on erineva pikkusega")
  }
  sapply(1:length(a), function(koht){a[koht]+b[koht]})  
}
veksum2(c(2, 3, 4), c(3, 4, 5))
## [1] 5 7 9

Kiiruste võrdlus

system.time(veksum1(1:100000, 1000001:1100000))
##    user  system elapsed 
##    0.16    0.00    0.15
system.time(veksum2(1:100000, 1000001:1100000))
##    user  system elapsed 
##    0.15    0.00    0.16