7 Funkcijų kūrimas

R turi visas pagrindines matematines funkcijas bei daug standartinių funkcijų skirtų statistinei analizei ir kitiems skaičiavimams. Dažnai duomenis reikia pertvarkyti taip, kad reikia apjungti ar taikyti skirtingas funcijas. Tokiais atvejais kelias išraiškas galima užrašyti kaip funkciją. Bendras funkcijos pavidalas yra toks:

Kodas

funkcijos.vardas <- function(arg1, arg2, ...) {
  
}

Čia function() yra funkcija skirta funkcijų kūrimui. Šiai funkcija visada privaloma nurodyti du argumentus: parametrus, esančius skliaustuose, ir funkcijos kūną (riestiniai skliaustai ir juose vykdomos išraiškos).

Bet kuri R funkcija yra function klasės objektas. Taigi, tokią sintaksę reikia suprasti taip: dešinėje pusėje sukuriamas function klasės objektas, kuris priskiriamas kintamajam funkcijos.vardas.

Funkcija gali turėti vieną ar daugiau argumentų, arba neturėti visai. Reikšmės argumentams priskiriamos naudojant = ženklą.

Pavyzdžiui, užrašysime funkciją, kuri grąžina vienetu didesnį už patį argumentą x skaičių.

Kodas

g <- function(x) {
  x+1
}

Kadangi funkcijos kūnas, arba kitaip tariant vykdomos išraiškos, rašomos bloko struktūroje, todėl funkcija grąžina paskutinę vykdomą išraišką.

Sukurta funkcija iškviečiama nurodant jos vardą ir skliaustuose įrašant argumentus.

Kodas

g(x = 10)
#> [1] 11

Funkcijos dvi pagrindines dalis (argumentus ir kūną) galima peržiūrėti atskirai. Tam atitinkamai naudojamos komandos formals() ir body().

Kodas

formals(g)
#> $x
body(g)
#> {
#>     x + 1
#> }

Kaip ir su kitais R objektais, nurodžius tik funkcijos pavadinimą, ji išvedami į konsolę. Naudinga tada, kai funkcijos veikimas nėra aiškus, ir norime patikrinti, kokie veiksmai atliekami funkcijoje.

Kodas

g
#> function (x) 
#> {
#>     x + 1
#> }

read.csv
#> function (file, header = TRUE, sep = ",", quote = "\"", dec = ".", 
#>     fill = TRUE, comment.char = "", ...) 
#> read.table(file = file, header = header, sep = sep, quote = quote, 
#>     dec = dec, fill = fill, comment.char = comment.char, ...)
#> <bytecode: 0x0000023dc5027310>
#> <environment: namespace:utils>

Jeigu funkcija vykdo išraišką, kuri telpa vienoje eilutėje, sintaksė šiek tiek sutrumpėje, nes galima atisisakyti riestinių skliaustų.

Kodas

g <- function(x) x+1
g(1)
#> [1] 2

7.0.1 Funkcijos argumentai

Sukursime funkciją, kuri apskaičiuoja sveikųjų skaičių nuo \(m\) iki \(n\) sumą. Skaičiai \(m\) ir \(n\) bus funkcijos argumentai.

Kodas

sekos.suma <- function(m, n) {
  v <- m:n
  sum(v)
}

Jei, iškviečiant funkciją, nurodomi argumentų pavadinimai, tai reikšmės jiems priskirti galima bet kokia tvarka.

Kodas

sekos.suma(m = 1, n = 5)
#> [1] 15
sekos.suma(n = 5, m = 1)
#> [1] 15

Jei argumentai rašomi nustatyta tvarka, jų pavadinimus galima praleisti.

Kodas

sekos.suma(1, 5)
#> [1] 15

Funkcijos argumentai gali turėti numatytas reikšmes. Pavyzdžiui, sumavimo funkciją pakeisime taip, kad nurodžius tik vieną argumentą n, būtų sumuojami sveikieji skaičiai nuo 1 iki \(n\). Argumentas m turės numatytą reikšmę lygią 1.

Kodas

sekos.suma <- function(n, m = 1) {
  v <- m:n
  sum(v)
}

Dabar pakanka nurodyti argumentą n.

Kodas

sekos.suma(5)
#> [1] 15

Jeigu funkcija turi argumentus su pagal nutylėjimą numatytomis reikšmėmis, tai jų nebūtina nurodyti. Jeigu nenorime, kad funkcija nebūtų vykdoma su numatyta tam tikra argumento reikšme, argumentą funkcijoje reikia iškviesti pagal jo vardą ir pakeisti reikšmę. R kalboje tokie argumentai vadinami named arguments.

Kai kviečiama funkcija, jos argumentų išraiškos nėra vykdomos iš karto, nes R taiko vadinamą lazy evaluation principą - vykdoma tik tada, kai reikia panaudoti. Pavyzdžiui, užrašysime funkciją, kurios argumentui b priskirsime tokią išraišką, kad ją įvykdžius kodas būtų sustabdytas ir konsolėje atsirastų pranešimas „b apskaičiuotas“.

Kodas

f <- function(a, b = stop("b apskaičiuotas")) a^2

f(3)
#> [1] 9

Funkcija veikia ir jokios klaidos čia nėra, nes funkcijos kūne argumentas b nebuvo panaudotas, todėl jam priskirta išraiška taip ir nebuvo įvykdyta.

7.0.2 Funkcijos grąžinamas objektas

Funkcija grąžina paskutinės jos išraiškos reikšmę. Jei ši reikšmė priskiriama kintamajam, papildomai reikia nurodyti, kurio kintamojo reikšmę grąžinti. Tam naudojama komanda return().

Kodas

sekos.suma <- function(m, n) {
  v <- m:n
  s <- sum(v)
  
  return(s)
}

Funkciją iš tikro gali grąžinti bet kokį objektą. Pavyzdžiui, pakeisime funkciją taip, kad jos rezultatas būtų sąrašas iš trijų elementų.

Kodas

sekos.suma <- function(m, n) {
  v <- m:n
  s <- sum(v)

  return(list(pirmas = m, paskutinis = n, suma = s))
}

sekos.suma(1, 5)
#> $pirmas
#> [1] 1
#> 
#> $paskutinis
#> [1] 5
#> 
#> $suma
#> [1] 15

7.0.3 Kodo nuskaitymas iš tekstinio failo

Praktikoje dažnai pasitaiko situacija, kai didelės apimties, įvairiais pagalbines ar keliose skirtingose programose naudojamas funkcijas patogiau yra aprašyti į atskirą tekstinį failą. Dėl to programos pasidaro kompaktiškesnės, lengviau skaitomos. Svarbu ir tai, kad pakoregavus funkciją, visose ją naudojančiose programose bus naudojama ta pati jos versija - užtikrinamas suderinamumas tarp programų.

Funkcijos, ar visos programos kodo nuskaitymui iš tekstinio failo naudojama funkcija source().

Importuosime funkcijas esančias faile funkcijos.R. Prieš tai išvalysime visus objektus iš globaliosios aplinkos.

Kodas

rm(list = ls())
source("examples/funkcijos.R")

Patikrinus globalioje aplinkoje esančius kintamuosius galima matyti importuotas funkcijas.

Kodas

ls()
#> [1] "c2f"         "is_even"     "no_na_mean"  "string_trim"

Užduotis

Sąlyga
Sprendimas

Skaičiaus ženklo nustatymui naudojama funkcija sign(). Sukurkit skaičiaus x ženklo nustatymo funkciją, kuri grąžina reikšmę 1, kai x teigiamas, reikšmę -1, kai x neigiamas, ir reikšmę 0, kai x yra lygus nuliui. Pabandykite išnaudoti logines reikšmes kaip skaitines.
Užrašykite funkciją Fibonačio skaičių sekos sudarymui. Pirmas ir antras jos nariai lygūs 1, o kiekvienas sekantis narys lygus dviejų paskutinių sumai. Šios funkcijos argumentas yra sekos narių skaičius n, \(n > 0\), o rezultatas yra n elementų turintis vektorius.
Užrašykite funkciją sveikojo skaičiaus iš dvejetainės skaičiavimo sistemos pervedimui į dešimtainę. Funkcijos argumentas – vektorius, kurio elementų reikšmės 0 arba 1. Pavyzdžiui, jei argumentas yra vektorius c(1, 1, 0, 1), rezultatas yra 13, jeigu argumentas c(1, 1, 1), tai rezultatas turi būti 7.
Tegu s yra \(n\) elementų turintis simbolių arba skaičių vektorius. Užrašykite funkciją, kuri surastų visas slenkančias k elementų dydžio sekas. Pvz., jei s = c("A", "B", "C", "D"), o k = 3, tai funkcijos rezultatas yra vektoriai c("A", "B", "C") ir c("B", "C", "D"). Gautas \(i\)-asis vektorius priskiriamas \(i\)-ajam sąrašo elementui ir galutinis rezultatas yra tokių vektorių sąrašas.

Kodas

# 1. 
nustatyti.zenkla <- function(x) {
  ifelse(x > 0, 1, 
         ifelse(x < 0, -1, 0))
}

nustatyti.zenkla(-2)
#> [1] -1

# 2. 
fibonacio_seka <- function(n) {
  
  # specialūs atvejai
  if (n == 1) return(1)
  if (n == 2) return(c(1, 1))

  # inicializuojame rezultatų vektorių
  fib <- numeric(n)
  fib[1:2] <- 1   

  # iteruojame ir užpildome likusius elementus
  for (i in 3:n) {
    fib[i] <- fib[i - 1] + fib[i - 2]
  }
  fib
}

fibonacio_seka(4)
#> [1] 1 1 2 3

# 3.
konvertuoti <- function(x) sum(rev(x) * 2^(seq_along(x) - 1))
konvertuoti(c(1, 0))
#> [1] 2

# 4.
seku.generavimas <- function(s, k) {
  n <- length(s)
  # if (k > n) stop("k negali būti didesnis nei vektoriaus ilgis")
  
  ats <- vector("list", length = n-k+1)
  for(i in seq_len(n-k+1)) {
    ats[[i]] <- s[i:(i+k-1)]
  }
  ats
}
seku.generavimas(LETTERS[1:4], 3)
#> [[1]]
#> [1] "A" "B" "C"
#> 
#> [[2]]
#> [1] "B" "C" "D"

7.0.4 Korektiškų funkcijų užrašymas

Funkcijos turi būti užrašytos taip, kad suveiktų tinkamai ir nekorektiškose situacijose. Tai labai svarbu dirbant su realiais duomenimis, kuriuose gali būti praleistų reikšmių, nes veiksmo su NA reikšme rezultas yra pati NA reikšmė. Kartais skaičiavimus tenka nutraukti dėl tam tikrų salygų netenkinimo.

Funkcijos `stop()` ir `stopifnot()`

Norint nutraukti funkcijos vykdymą naudojama funkcija stop(). Įprastai ši funkcija naudojama kartu su sąlygos konstrukcija if-else.

Pavyzdžiui, sukursime funkciją \(f(x) = 1/x\). Prieš atliekant skaičiavimus, bus patikrinama, ar x nelygus 0. Jei sąlyga tenkinama, skaičiavimai nutraukiami.

Kodas

fx.a <- function(x) {
  if (x == 0) stop("x negali būti lygus 0")
  return(1/x)
}

fx.a(5)
#> [1] 0.2
fx.a(0)
#> Error in fx.a(0): x negali būti lygus 0

Prieš atliekant skaičiavimus kartais tenka patikrinti, ar f-jos argumentai yra tam tikro tipo.

Pavyzdžiui, užrašysime funkciją, kurios argumentas gali būti tik vektorius (bet kokio tipo), priešingu atveju skaičiavimai neatliekami.

Kodas

fx.b <- function (x) {
  if (!is.vector(x)) stop("x nėra vektorius")

  y <- length(x)
  names(y) <- "Elementų skaičius"
  return(y)
}

fx.b(100:150)
#> Elementų skaičius 
#>                51
fx.b(letters)
#> Elementų skaičius 
#>                26
fx.b(matrix(1))
#> Error in fx.b(matrix(1)): x nėra vektorius

Kartais reikia funkcijos veikimą nutraukti jeigu netenkinama bent viena iš keletos loginių sąlygų. Šių sąlygų patikrinimui vietoj if-else konstrukcijų kartu su funkcija stop(), galima naudoti funkciją stopifnot(). Funkcijos parametrai yra loginės sąlygos, kurios nuosekliai patikrinamos.

Pavyzdžiui, užrašysime funkciją, kurios argumentas turi būti ne mažiau kaip 5 reikšmes turintis skaitinis vektorius be praleistų reikšmių.

Kodas

fx.s <- function(x) {

  stopifnot(is.vector(x), is.numeric(x), length(x) >= 5, all(!is.na(x)))

  y <- mean(x)
  names(y) <- "Vidurkis"
  return(y)
}

x <- c(10.5, 14.2, 3.1)
y <- c(10.7, 10.4, 9.9, NA, 7)
z <- c(11.5, 13.3, 8.2, 10, 9)

fx.s(x)
#> Error in fx.s(x): length(x) >= 5 nėra TRUE
fx.s(y)
#> Error in fx.s(y): all(!is.na(x)) nėra TRUE
fx.s(z)
#> Vidurkis 
#>     10.4

Jei visų loginių sąlygų reikšmė yra TRUE, funkcija grąžina NULL reikšmę. Jeigu bent vienos sąlygos reikšmė nėra TRUE, suvykdoma funkcija stop() ir į konsolę išvedamas pranešimas apie pirmą ne TRUE reikšmę turinčią sąlygą (jei tokia yra ne viena). Šiuo atveju vektorius x netenkina antrosios sąlygos, o vektorius y - trečiosios, todėl atitinkamais atvejais buvo gauti klaidos pranešimai.

Funkcijos `message()` ir `warning()`

Kartais reikia, kad funkcija tam tikrais skaičiavimo etapais išvestų pranešimą apie atliekamus veiksmus. Tam naudojama funkcija message(). Jos pagrindiniai parametrai: ... – vienas ar keli kintamieji, kurių reikšmė yra tekstas, appendLF – TRUE, nurodo, kad kitas pranešimas bus naujoje eilutėje.

Pavyzdžiui, anksčiau užrašytą funkciją papildysime informaciniais pranešimais apie sąlygų duomenims tikrinimą ir skaičiavimų etapo pradžią.

Kodas

fx.m <- function(x) {

  message("Tikrinamos sąlygos ... ", appendLF = FALSE)
  stopifnot(is.vector(x), is.numeric(x), length(x) >= 5, all(!is.na(x)))
  message("atlikta.")

  message("Atliekami skaičiavimai.")
  y <- mean(x)
  names(y) <- "Vidurkis"

  return(y)
}

fx.m(x)
#> Error in fx.m(x): length(x) >= 5 nėra TRUE
fx.m(y)
#> Error in fx.m(y): all(!is.na(x)) nėra TRUE
fx.m(z)
#> Vidurkis 
#>     10.4

Ne visi pranešimai turi vienodą svarbą. Įvairiems perspėjimams naudojama funkcija warning().

Argumentas	Reikšmė
`...`	Vienas ar keli kintamieji, kurių reikšmė yra tekstas.
`call.`	`TRUE`, pranešime nurodoma išraiška, kurioje įvyko klaida.
`immediate.`	`FALSE`, nurodo, kad pranešimas būtų išvedamas iš karto.

Pavyzdžiui, funkciją perrašysime taip, kad skaičiavimai dėl praleistų reikšmių duomenyse nebus nutraukiami. Sąlyga dėl praleistų reikšmių tikrinama atskirai, ir, jei tokių reikšmių yra, skaičiavimai atliekami, bet išvedamas perspėjimas.

Kodas

fx.w <- function(x) {

  stopifnot(is.vector(x), is.numeric(x), length(x) >= 5)
  if (any(is.na(x))) warning("Duomenyse yra praleistų reikšmių", call. = FALSE)

  y <- mean(x, na.rm = TRUE)
  names(y) <- "Vidurkis"

  return(y)
}

fx.w(x)
#> Error in fx.w(x): length(x) >= 5 nėra TRUE
fx.w(y)
#> Vidurkis 
#>      9.5
fx.w(z)
#> Vidurkis 
#>     10.4

Užduotis

Sąlyga
Sprendimas

Užrašykite funkciją, kuri apskaičiuoja skaitinio vektoriaus elementų sandaugą. Naudojant funkciją stop(), nutraukite skaičiavimus, jei bent vienas elementas lygus nuliui.
Naudodami funkciją stopifnot(), užrašykite išraišką, kuri patikrina ar kintamasis x yra neneigiamų skaičių vektorius.
Naudodami funkciją stopifnot(), patikrinite, ar funkcijos argumentas yra \(3 \times 3\) dydžio skaitinė matrica be praleistų reikšmių.

Kodas

# 1. 
num.sandauga <- function(x) {
  if(any(x == 0)) stop("Tarp vektoriaus elementų yra nulis")
  prod(x)
}

num.sandauga(c(1, -2, 5))
#> [1] -10
num.sandauga(c(0, -2, 5))
#> Error in num.sandauga(c(0, -2, 5)): Tarp vektoriaus elementų yra nulis

# 2.
num.sandauga_2 <- function(x) {
  stopifnot(is.vector(x), is.numeric(x), all(x >= 0))
  prod(x)
}

num.sandauga_2(c(0, 2, 5))
#> [1] 0
num.sandauga_2(c(0, -2, 5))
#> Error in num.sandauga_2(c(0, -2, 5)): all(x >= 0) nėra TRUE

# 3.
num.sandauga_3 <- function(x) {
  stopifnot(is.matrix(x), all(dim(x) == 3), is.numeric(x), any(!is.na(x)))
  prod(x)
}

num.sandauga_3(1:9)
#> Error in num.sandauga_3(1:9): is.matrix(x) nėra TRUE
num.sandauga_3(matrix(1:9))
#> Error in num.sandauga_3(matrix(1:9)): all(dim(x) == 3) nėra TRUE
num.sandauga_3(matrix(1:9, nrow = 3))
#> [1] 362880

7.0.5 `switch` teiginys

Su if yra glaudžiai susijęs switch() sąlygos teiginys. Tai kompaktiškas, specialios paskirties ekvivalentas, leidžiantis pakeisti tokį kodą kaip:

Kodas

x_option <- function(x) {
  if (x == "a") {
    "pasirinkimas 1"
  } else if (x == "b") {
    "pasirinkimas` 2" 
  } else if (x == "c") {
    "pasirinkimas` 3"
  } else {
    stop("Netinkama `x` reikšmė")
  }
}

į trumpesnį:

Kodas

x_option <- function(x) {
  switch(x,
    a = "pasirinkimas 1",
    b = "pasirinkimas 2",
    c = "pasirinkimas 3",
    stop("Netinkama `x` reikšmė")
  )
}

Paskutinis switch() komponentas visada turi grąžinti klaidą, kitaip nesutampantys įvesties duomenys grąžinsNULL.

Kodas

(switch("c", a = 1, b = 2))
#> NULL

Rekomenduojama switch() naudoti tik tada, kai x yra character tipo.

7.1 apply funkcijų šeima

R kalboje yra daug standartinių funkcijų, skirtų skaitinėms vektorių charakteristikoms apskaičiuoti.

length(v)   # elementų skaičius  
min(v)      # minimumas  
max(v)      # maksimumas  
sum(v)      # suma  
median(v)   # mediana  
mean(v)     # vidurkis

Statistikoje šios ir kitos charakteristikos dažnai skaičiuojamos matricoms ar duomenų lentelėms. Kadangi matrica susideda iš stulpelių, kurių kiekvienas yra vektorius, galima taikyti ciklą ir taip apskaičiuoti visų matricos stulpelių ar eilutučių pasirinktą charakteristiką.

Pavyzdžiui, apskaičiuokime matricos eilučių sumas naudodami for ciklą.

Kodas

v <- c(60, 9, 61, 62, 64, 4, 91, 6, 57, 2, 78, 76, 3, 41, 72, 95, 47, 11, 8, 96)
m <- matrix(v, ncol = 5)
eilutes_suma <- vector()

for (i in 1:nrow(m)) {
  eilute <- m[i, ]
  eilutes_suma[i] <- sum(eilute)
}
eilutes_suma
#> [1] 231  67 310 335

Tokia programavimo logika, kai išsamiai aprašomi visi skaičiavimų žingsniai, būdinga imperatyviniam programavimui, kur svarbus kintamasis ir veiksmų seka.

Tačiau R yra funkcinio programavimo kalba. Funkciniame programavime viskas traktuojama kaip funkcijų (matematine prasme) reikšmių skaičiavimas, priklausantis nuo įvesties duomenų ir kitų funkcijų rezultatų.

Skirtumai tarp funkcinio ir imperatyvinio programavimo yra esminiai. Vienas iš jų — funkciniame programavime nenaudojami ciklai. Vietoj jų naudojama rekursija (funkcija kviečia pati save).

Dėl tos priežasties, programuojant su R reikia prisiminti taisyklę:

JEI KYLA NORAS RAŠYTI FOR CIKLĄ, TAI GREIČIAUSIAI JIS ČIA VISAI NEREIKALINGAS. — Tomas Rekašius

Šiam tikslui R naudojamos apply šeimos funkcijos, kurių aprašymui skirta ši konspekto dalis.

7.1.1 Funkcija `apply()`

Daug statistinių skaičiavimų atliekama su matricomis. Jei tam tikrus veiksmus reikia taikyti visoms matricos eilutėms arba stulpeliams, ir tuos veiksmus galima aprašyti kaip funkciją, tam naudojama funkcija apply().

Argumentas	Reikšmė
`X`	Matricos pavadinimas.
`margin`	Indekso reikšmė: 1 - eilutėms, 2 - stulpeliams.
`FUN`	Taikoma funkcija.
`...`	Papildomi taikomos funkcijos parametrai.

Pavyzdžiui, apskaičiuokime matricos m eilučių ir stulpelių sumas:

Kodas

apply(m, 1, sum)   # eilučių sumos  
#> [1] 231  67 310 335
apply(m, 2, sum)   # stulpelių sumos
#> [1] 192 165 213 211 162

Argumentas FUN gali būti bet kuri R funkcija, kuri kaip argumentą priima vektorių. Pvz., kiekvienam stulpeliui apskaičiuojamos kelias skaitinės charakteristikos:

Kodas

apply(m, 2, summary)
#>          [,1]  [,2]  [,3]  [,4]  [,5]
#> Min.     9.00  4.00  2.00  3.00  8.00
#> 1st Qu. 47.25  5.50 43.25 31.50 10.25
#> Median  60.50 35.00 66.50 56.50 29.00
#> Mean    48.00 41.25 53.25 52.75 40.50
#> 3rd Qu. 61.25 70.75 76.50 77.75 59.25
#> Max.    62.00 91.00 78.00 95.00 96.00

Kartais reikia atlikti tokius skaičiavimus, kuriuos R neturi aprašytos kaip atskiros funkcijos. Tuomet ją reikia susikurti pačiam. Pvz., jei reikia apskaičiuoti mažiausios ir didžiausios reikšmės vidurkį:

Kodas

minmax_vidurkis <- function(x) {
  min <- min(x)
  max <- max(x)
  (min + max) / 2
}

apply(m, 2, minmax_vidurkis)
#> [1] 35.5 47.5 40.0 49.0 52.0

Funkcinio programavimo stiliuje tai galima užrašyti trumpiau, nenaudojant tarpinių kintamųjų.

Kodas

minmax_vidurkis <- function(x) mean(range(x))
apply(m, 2, minmax_vidurkis)
#> [1] 35.5 47.5 40.0 49.0 52.0

Kai funkciją galima aprašyti trumpai, ją patogu įrašyti anonimiškai – tiesiai į apply iškvietimą, nesuteikiant jai pavadinimo.

Kodas

apply(m, 2, function(x) mean(range(x)))
#> [1] 35.5 47.5 40.0 49.0 52.0

Tokios anoniminės funkcijos (angl. anonymous functions) yra įprasta praktika funkcinėje R programavime. Čia x reikšmė priklauso nuo MARGIN: jei 1 – x yra vektorius eilutė, jei 2 – vektorius stulpelis.

Nuo R-4.1 versijos anonimines funkcijas galima užrašyti trumpesne sintakse. Vietoje function naudojamas simbolis \. Pavyzdžiui, paskutinę funkciją perrašyme pagal naują sintaksę.

Kodas

apply(m, 2, \(x) mean(range(x)))
#> [1] 35.5 47.5 40.0 49.0 52.0

Daug R funkcijų turi papildomų parametrų. Pvz., sum() turi parametrą na.rm, leidžiantį ignoruoti praleistas reikšmes (NA). Šiuos parametrus perduodame per ....

Kodas

u <- c(60, 9, NA, 62, 64, 4, 91, 6, 57, NA)
n <- matrix(u, ncol = 5)

apply(n, 2, sum)  # su NA reikšmėmis
#> [1] 69 NA 68 97 NA
apply(n, 2, sum, na.rm = TRUE)  # be NA reikšmių
#> [1] 69 62 68 97 57

Užduotis

Sąlyga
Sprendimas

Naudojant funkciją apply(), užrašykite komandą, kuri apskaičiuotų matricos m stulpelių vidurkį. Užrašykite tokią komandos versiją, kuri apskaičiuotų tik pirmų dviejų stulpelių vidurkius.
Naudojant f-ją apply(), užrašykite komandą, kuri matricos stulpelių elementus išrikiuotu didėjimo tvarka. Vektoriaus elementų išrikiavimui naudojama f-ja sort(). Užrašykite tokią komandos versiją, kuri išrikiuoti stulpelių elementus mažėjimo tvarka.
Naudojant f-ją apply(), užrašykite komandą, kuri iš skaičių matricos m eilučių išrinktų po du didžiausius elementus. Funkciją dviejų didžiausių vektoriaus elementų išrinkimui galima užrašyiti atskirai ir įstatyti ją į f-ją apply().
Naudodami funkciją apply(), apskaičiuokite, kiek matricos m stulpeliuose yra elementų, kurių reikšmės didesnės nei 50.

Kodas

# 1. 
apply(m, 2, mean)
apply(m[, 1:2], 2, mean)

# 2.
apply(m, 2, sort)
apply(m, 2, sort, decreasing = TRUE)

# 3. 
max.du <- function(x) sort(x, decreasing = T)[1:2] 
apply(m, 1, max.du)

# arba naudojant anoniminę funkciją
apply(m, 1, \(x) sort(x, decreasing = T)[1:2])

# 4. 
apply(m, 2, function(x) sum(x > 50))
apply(m, 2, \(x) sum(x > 50))

7.1.2 Funkcijos `lapply()` ir `sapply()`

Skaičiavimams su sąrašais (list objektais) vietoje apply() funkcijos naudojamos lapply() ir sapply().

Argumentas	Reikšmė
`X`	Matricos pavadinimas.
`FUN`	Taikoma funkcija.
`...`	Papildomi taikomos funkcijos parametrai.

Vienintelis šių funkcijų skirtumas yra rezultatų pateikimo forma. Kai FUN rezultatas yra sudėtingas objektas ir reikia rezultatą grąžinti sąrašo tipo struktūra, naudojama lapply(). Jei rezultatas yra vienas skaičius, simbolis ar loginė reikšmė – patogiau naudoti sapply(), nes ji grąžina vektorių arba matricą.

Pavyzdžiui, apskaičiuosime penkių nevienodo ilgio vektorių vidurkius.

Kodas

v1 <- c(11, 21, 38, 32, 7, 41, 14, 10, 32, 19, 42, 28, 33, 38, 5, 17)
v2 <- c(30, 38, 22, 38, 45, 23, 23, 3, 18, 38)
v3 <- c(61, 71, 98, 81, 59, 76, 92, 31, 89, 32, 83, 43)
v4 <- c(81, 95, 74, 61, 27, 73, 60, 72, 50, 32, 79, 32, 10, 74)
v5 <- c(12, 14, 56, 45, 6, 85, 64, 8, 59, 59, 69, 5, 50, 34)

l <- list(Pirmas = v1, Antras = v2, Trečias = v3, Ketvirtas = v4, Penktas = v5)

lapply(l, mean)   # grąžina sąrašą
#> $Pirmas
#> [1] 24.25
#> 
#> $Antras
#> [1] 27.8
#> 
#> $Trečias
#> [1] 68
#> 
#> $Ketvirtas
#> [1] 58.57143
#> 
#> $Penktas
#> [1] 40.42857
sapply(l, mean)   # grąžina vardinį vektorių
#>    Pirmas    Antras   Trečias Ketvirtas   Penktas 
#>  24.25000  27.80000  68.00000  58.57143  40.42857

Jei funkcijos rezultatas yra vektorius, lapply() grąžina sąrašą, o sapply() – matricą.

Kodas

rez_l <- lapply(l, summary)
rez_l
#> $Pirmas
#>    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
#>    5.00   13.25   24.50   24.25   34.25   42.00 
#> 
#> $Antras
#>    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
#>    3.00   22.25   26.50   27.80   38.00   45.00 
#> 
#> $Trečias
#>    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
#>    31.0    55.0    73.5    68.0    84.5    98.0 
#> 
#> $Ketvirtas
#>    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
#>   10.00   36.50   66.50   58.57   74.00   95.00 
#> 
#> $Penktas
#>    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
#>    5.00   12.50   47.50   40.43   59.00   85.00

rez_s <- sapply(l, summary)
rez_s
#>         Pirmas Antras Trečias Ketvirtas  Penktas
#> Min.      5.00   3.00    31.0  10.00000  5.00000
#> 1st Qu.  13.25  22.25    55.0  36.50000 12.50000
#> Median   24.50  26.50    73.5  66.50000 47.50000
#> Mean     24.25  27.80    68.0  58.57143 40.42857
#> 3rd Qu.  34.25  38.00    84.5  74.00000 59.00000
#> Max.     42.00  45.00    98.0  95.00000 85.00000

Galime lengvai atlikti analizę, pavyzdžiui, surasti, kurio vektoriaus minimumas yra didžiausias:

Kodas

which.max(rez_s[1, ])
#> Trečias 
#>       3

Į funkciją lapply() arba sapply() įstačius duomenų lentelę, funkcija „perbėga“ per stulpelius. Naudodami funkciją class(), nustatysime duomenų lentelės kintamųjų tipą.

Kodas

df <- data.frame(x = 1:5, y = letters[1:5], z = TRUE)

sapply(df, class)
#>           x           y           z 
#>   "integer" "character"   "logical"
lapply(df, class)
#> $x
#> [1] "integer"
#> 
#> $y
#> [1] "character"
#> 
#> $z
#> [1] "logical"

Elementų išskyrimo operetorių [ galima naudoti kaip funkciją. Pavyzdžiui, išskirsime į atskirus vektorius (kaip sąrašo elementus) duomenų lentelės stulpelius.

Kodas

lapply(df, "[")
#> $x
#> [1] 1 2 3 4 5
#> 
#> $y
#> [1] "a" "b" "c" "d" "e"
#> 
#> $z
#> [1] TRUE TRUE TRUE TRUE TRUE

Užduotis

Sąlyga
Sprendimas

Naudojant funkciją sapply(), užrašykite išraišką, kuri surastų kiekvieno vektoriaus iš sąrašo l didžiausią reikšmę. Užrašykite išraišką, kuri rastų bendrą visų maksimumų maksimumą (didžiausią reikšmę tarp visų vektorių).
Naudojant funkciją sapply(), užrašykite išraišką, kuri apskaičiuotų kiekvieno vektoriaus iš sąrašo l elementų kvadratų sumą.
Užrašykite tokią išraišką, kuri nustatytų, kuris sąrašo l vektorius turi didžiausią skirtumą tarp savo didžiausios ir mažiausios reikšmės. Atsakymas turi būti sąrašo elemento (vektoriaus) numeris.
Naudojant funkciją sapply(), apskaičiuokite, kiek kiekvienas sąrašo l vektorius turi elementų, kurių reikšmės didesnės nei 50.
Naudojant funkciją lapply(), užrašykite komandą, kuri iš kiekvieno sąrašo l vektoriaus suformuotų matricą su dviem stulpeliais.
Funkciją lapply() pritaikant vektoriui, užrašykite komandą, kuri intervalą \([0, 1]\) lygiomis dalimis padalina į 10, 20 ir 30 dalių. Intervalą dalinančių taškų sekai naudokite funkciją seq() su parametru length.out.
Naudojant funkciją sapply(), patikrinkite, kurie duomenų lentelės df stulpeliai yra numeric tipo. Užrašykite išraišką, kuri suskaičiuotų, kiek tokių stulpelių lentelėje yra iš viso.
Naudojant funkciją lapply(), užrašykite komandą, kuri iš kiekvieno sąrašo l vektoriaus pašalintų reikšmes, mažesnes nei 30.
Naudojant funkciją lapply(), užrašykite komandą, kuri kiekvieną sąrašo l vektorių normalizuotų – t. y. iš kiekvieno elemento atimtų vidurkį ir padalytų iš standartinio nuokrypio.x
Parašykite išraišką, kuri apskaičiuoja, kokią dalį kiekvieno vektoriaus elementų sudaro lyginių skaičių reikšmės, ir grąžina rezultatą kaip vektorių.

Kodas

# 1. 
sapply(l, max)
#>    Pirmas    Antras   Trečias Ketvirtas   Penktas 
#>        42        45        98        95        85
max(sapply(l, max))
#> [1] 98

# 2.
sapply(l, \(x) sum(x^2))
#>    Pirmas    Antras   Trečias Ketvirtas   Penktas 
#>     11836      9132     61292     55990     32326

# 3.
which.max(sapply(l, \(x) max(x) - min(x)))
#> Ketvirtas 
#>         4

# 4.
sapply(l, \(x) sum(x > 50))
#>    Pirmas    Antras   Trečias Ketvirtas   Penktas 
#>         0         0         9         9         6

# 5.
lapply(l, \(x) matrix(x, ncol = 2))
#> $Pirmas
#>      [,1] [,2]
#> [1,]   11   32
#> [2,]   21   19
#> [3,]   38   42
#> [4,]   32   28
#> [5,]    7   33
#> [6,]   41   38
#> [7,]   14    5
#> [8,]   10   17
#> 
#> $Antras
#>      [,1] [,2]
#> [1,]   30   23
#> [2,]   38   23
#> [3,]   22    3
#> [4,]   38   18
#> [5,]   45   38
#> 
#> $Trečias
#>      [,1] [,2]
#> [1,]   61   92
#> [2,]   71   31
#> [3,]   98   89
#> [4,]   81   32
#> [5,]   59   83
#> [6,]   76   43
#> 
#> $Ketvirtas
#>      [,1] [,2]
#> [1,]   81   72
#> [2,]   95   50
#> [3,]   74   32
#> [4,]   61   79
#> [5,]   27   32
#> [6,]   73   10
#> [7,]   60   74
#> 
#> $Penktas
#>      [,1] [,2]
#> [1,]   12    8
#> [2,]   14   59
#> [3,]   56   59
#> [4,]   45   69
#> [5,]    6    5
#> [6,]   85   50
#> [7,]   64   34

# 6.
# 10*1:3 + 1 tas pats kas c(11, 21, 31)
lapply(10*1:3 + 1, \(n) seq(0, 1, length.out = n))
#> [[1]]
#>  [1] 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0
#> 
#> [[2]]
#>  [1] 0.00 0.05 0.10 0.15 0.20 0.25 0.30 0.35 0.40 0.45 0.50 0.55 0.60 0.65 0.70
#> [16] 0.75 0.80 0.85 0.90 0.95 1.00
#> 
#> [[3]]
#>  [1] 0.00000000 0.03333333 0.06666667 0.10000000 0.13333333 0.16666667
#>  [7] 0.20000000 0.23333333 0.26666667 0.30000000 0.33333333 0.36666667
#> [13] 0.40000000 0.43333333 0.46666667 0.50000000 0.53333333 0.56666667
#> [19] 0.60000000 0.63333333 0.66666667 0.70000000 0.73333333 0.76666667
#> [25] 0.80000000 0.83333333 0.86666667 0.90000000 0.93333333 0.96666667
#> [31] 1.00000000

# 7.
num_cols <- sapply(df, is.numeric)
num_cols
#>     x     y     z 
#>  TRUE FALSE FALSE
sum(num_cols)
#> [1] 1

# 8.
lapply(l, \(x) x[x >= 30])
#> $Pirmas
#> [1] 38 32 41 32 42 33 38
#> 
#> $Antras
#> [1] 30 38 38 45 38
#> 
#> $Trečias
#>  [1] 61 71 98 81 59 76 92 31 89 32 83 43
#> 
#> $Ketvirtas
#>  [1] 81 95 74 61 73 60 72 50 32 79 32 74
#> 
#> $Penktas
#> [1] 56 45 85 64 59 59 69 50 34

# 9.
lapply(l, \(x) (x - mean(x))/sd(x))
#> $Pirmas
#>  [1] -1.0416615 -0.2555019  1.0809695  0.6092737 -1.3561254  1.3168174
#>  [7] -0.8058136 -1.1202775  0.6092737 -0.4127338  1.3954334  0.2948099
#> [13]  0.6878897  1.0809695 -1.5133573 -0.5699657
#> 
#> $Antras
#>  [1]  0.1761661  0.8167699 -0.4644378  0.8167699  1.3772983 -0.3843623
#>  [7] -0.3843623 -1.9858720 -0.7847397  0.8167699
#> 
#> $Trečias
#>  [1] -0.3047409  0.1306032  1.3060322  0.5659473 -0.3918097  0.3482753
#>  [7]  1.0448258 -1.6107731  0.9142226 -1.5672387  0.6530161 -1.0883602
#> 
#> $Ketvirtas
#>  [1]  0.90631212  1.47203561  0.62345037  0.09813571 -1.27576419  0.58304155
#>  [7]  0.05772689  0.54263273 -0.34636132 -1.07372009  0.82549448 -1.07372009
#> [13] -1.96271414  0.62345037
#> 
#> $Penktas
#>  [1] -1.0547799 -0.9805743  0.5777438  0.1696129 -1.2773968  1.6537253
#>  [7]  0.8745663 -1.2031912  0.6890522  0.6890522  1.0600803 -1.3144996
#> [13]  0.3551269 -0.2385181

# 10.
sapply(l, \(x) mean(x %% 2 == 0))
#>    Pirmas    Antras   Trečias Ketvirtas   Penktas 
#> 0.5000000 0.6000000 0.3333333 0.5714286 0.5714286

7.1.3 Funkcija `mapply()`

Funkcijos apply(), lapply() ar sapply() perbėga per duomenų rinkinio elementus ir kaip argumentus juos perduoda kitai, taikomai funkcijai. Tas perduodamas duomenų rinkinys gali būti ir funkcijos kokio nors vieno parametro reikšmių vektorius. Tokiu būdu galima reguliuoti funkcijos veikimą.

Funkcija mapply() (multivariate apply) leidžia vienu metu perbėgti per kelis argumentų vektorius ir kiekvienoje iteracijoje atitinkamus jų reikšmes perduoti taikomai funkcijai FUN.

Argumentas	Reikšmė
`FUN`	Taikoma funkcija.
`...`	Taikomai funkcijai perduodami parametrai.
`MoreArgs`	Sąrašas nekintančių (visoms iteracijoms bendrų) argumentų.
`SIMPLIFY`	`TRUE`, bandoma rezultatą supaprastinti iki matricos ar vektoriaus.

Pavyzdžiui, naudodami standartinę funkciją seq(), intervalą \([0, 1]\) padalinsime į 10, 50 ir 100 vienodų dalių. Taškų skaičių nusako funkcijos parametras length.out.

Kodas

mapply(seq, from = 0, to = 1, length.out = c(11, 51, 101))
#> [[1]]
#>  [1] 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0
#> 
#> [[2]]
#>  [1] 0.00 0.02 0.04 0.06 0.08 0.10 0.12 0.14 0.16 0.18 0.20 0.22 0.24 0.26 0.28
#> [16] 0.30 0.32 0.34 0.36 0.38 0.40 0.42 0.44 0.46 0.48 0.50 0.52 0.54 0.56 0.58
#> [31] 0.60 0.62 0.64 0.66 0.68 0.70 0.72 0.74 0.76 0.78 0.80 0.82 0.84 0.86 0.88
#> [46] 0.90 0.92 0.94 0.96 0.98 1.00
#> 
#> [[3]]
#>   [1] 0.00 0.01 0.02 0.03 0.04 0.05 0.06 0.07 0.08 0.09 0.10 0.11 0.12 0.13 0.14
#>  [16] 0.15 0.16 0.17 0.18 0.19 0.20 0.21 0.22 0.23 0.24 0.25 0.26 0.27 0.28 0.29
#>  [31] 0.30 0.31 0.32 0.33 0.34 0.35 0.36 0.37 0.38 0.39 0.40 0.41 0.42 0.43 0.44
#>  [46] 0.45 0.46 0.47 0.48 0.49 0.50 0.51 0.52 0.53 0.54 0.55 0.56 0.57 0.58 0.59
#>  [61] 0.60 0.61 0.62 0.63 0.64 0.65 0.66 0.67 0.68 0.69 0.70 0.71 0.72 0.73 0.74
#>  [76] 0.75 0.76 0.77 0.78 0.79 0.80 0.81 0.82 0.83 0.84 0.85 0.86 0.87 0.88 0.89
#>  [91] 0.90 0.91 0.92 0.93 0.94 0.95 0.96 0.97 0.98 0.99 1.00

Čia parametrų from ir to reikšmės fiksuotos, nes dalinamas tas pats intervalas. Nekintančius taikomos funkcijos parametrus galima perduoti per parametrą MoreArgs.

Kodas

mapply(seq, length.out = c(11, 51, 101), MoreArgs = list(from = 0, to = 1))
#> [[1]]
#>  [1] 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0
#> 
#> [[2]]
#>  [1] 0.00 0.02 0.04 0.06 0.08 0.10 0.12 0.14 0.16 0.18 0.20 0.22 0.24 0.26 0.28
#> [16] 0.30 0.32 0.34 0.36 0.38 0.40 0.42 0.44 0.46 0.48 0.50 0.52 0.54 0.56 0.58
#> [31] 0.60 0.62 0.64 0.66 0.68 0.70 0.72 0.74 0.76 0.78 0.80 0.82 0.84 0.86 0.88
#> [46] 0.90 0.92 0.94 0.96 0.98 1.00
#> 
#> [[3]]
#>   [1] 0.00 0.01 0.02 0.03 0.04 0.05 0.06 0.07 0.08 0.09 0.10 0.11 0.12 0.13 0.14
#>  [16] 0.15 0.16 0.17 0.18 0.19 0.20 0.21 0.22 0.23 0.24 0.25 0.26 0.27 0.28 0.29
#>  [31] 0.30 0.31 0.32 0.33 0.34 0.35 0.36 0.37 0.38 0.39 0.40 0.41 0.42 0.43 0.44
#>  [46] 0.45 0.46 0.47 0.48 0.49 0.50 0.51 0.52 0.53 0.54 0.55 0.56 0.57 0.58 0.59
#>  [61] 0.60 0.61 0.62 0.63 0.64 0.65 0.66 0.67 0.68 0.69 0.70 0.71 0.72 0.73 0.74
#>  [76] 0.75 0.76 0.77 0.78 0.79 0.80 0.81 0.82 0.83 0.84 0.85 0.86 0.87 0.88 0.89
#>  [91] 0.90 0.91 0.92 0.93 0.94 0.95 0.96 0.97 0.98 0.99 1.00

Užrašysime paprastą funkciją, kuri iš ilgos simbolių sekos iškarpo trumpesnes sekas. Šios funkcijos argumentai yra trumpesnės sekos pradžios ir pabaigos indeksų vektoriai. Kadangi duomenys - ilgoji seka - nesikeičia, ją įrašome į fiksuotų parametrų sąrašą.

Kodas

s <- c("G", "C", "T", "T", "T", "T", "C", "A", "T", "T", "C", "T", "G", "A", "C")

start <- c(1, 5, 8)
stop <- c(7, 10, 15)

mapply(\(seka, i, j) seka[i:j], i = start, j = stop, MoreArgs = list(seka = s))
#> [[1]]
#> [1] "G" "C" "T" "T" "T" "T" "C"
#> 
#> [[2]]
#> [1] "T" "T" "C" "A" "T" "T"
#> 
#> [[3]]
#> [1] "A" "T" "T" "C" "T" "G" "A" "C"

Užduotis

Sąlyga
Sprendimas

Derinių skaičiui apskaičiuoti naudojama R funkcija choose(n, k). Naudodami mapply, užrašykite išraišką, kuri apskaičiuotų: derinių skaičių iš 5 po 2 ir derinių skaičių iš 10 po 3.
Siekiant pašalinti išsiskiriančių reikšmių įtaką, vietoje vidurkio kartais skaičiuojamas nukirstas vidurkis (angl. truncated mean). Tai vidurkis skaičiuotas imčiai, iš kurios atmesta \(k\cdot 100%\) didžiausių ir mažiausių reikšmių. Vidurkio funkcija mean(), turi tam skirtą parametrą trim, reikšmę iš intervalo \([0; 0.5]\). Naudojant mapply(), užrašykite funkciją, kuri apskaičiuotų \(0.1\), \(0.15\), \(0.2\) lygio nukirstus vidurkius. Tokią pačia funkciją užrašykite su f-ja sapply().
Naudodami mapply() apskaičiuokite integralo \[\begin{equation*} \int_{0}^1 x^p \, \mathrm{d}x \end{equation*}\] reikšmę penkiems laipsniams \(p = 1, 2, 3, 4, 5\). Rezultatas turi būti penkių elementų vektorius, kuriame kiekviena reikšmė atitinka tam tikro p integralo vertę. Integralo skaičiavimui naudojama funkcija integrate().

Kodas

# 1. 
mapply(choose, n = c(5, 10), k = c(2, 3))
#> [1]  10 120

# 2.
set.seed(1)
data <- rnorm(50)
trim_lvl <- c(0.1, 0.15, 0.2)

# su mapply()
mapply(mean, trim = trim_lvl, MoreArgs = list(x = data))
#> [1] 0.1554802 0.1634544 0.1778781

# su sapply()
sapply(trim_lvl, function(trim) mean(data, trim))
#> [1] 0.1554802 0.1634544 0.1778781

# 3.
mapply(\(p) integrate(f = \(x) x^p, lower = 0, upper = 1)$value, p = 1:5)
#> [1] 0.5000000 0.3333333 0.2500000 0.2000000 0.1666667

7.2 Funkcijos skaičiavimas grupėse

Atliekant duomenų analizę, tam tikras skaitines charakteristikas kartais tenka skaičiuoti ne visam duomenų rinkiniui, bet atskiroms duomenų grupėms. Duomenys, kurie išskaidomi pagal tam tikras grupes, dažniausiai gali būti vektoriaus arba duomenų lentelės struktūros.

7.2.1 Funkcija `tapply()`

Tuo atveju, kai tą pačią funkciją reikia pritaikyti keliems vieno vektoriaus pogrupiams, naudojama funkcija tapply().

Argumentas	Reikšmė
`X`	Duomenų vektorius.
`INDEX`	Duomenis grupuojantis vektorius.
`FUN`	Taikoma funkcija.
`simplify`	Jei `TRUE`, rezultatas grąžinamas kaip vektoriaus.

Argumentui INDEX priskiriamas vektorius turi turėti tiek pat elementų, kiek ir duomenų vektorius X.

Pavyzdžiui, apskaičiuosime vektoriaus x vidurkį grupėse pagal vektoriaus g elementų reikšmes. Rezultatas yra sąlyginis x vidurkis atskirai grupėje A ir grupėje B.

Kodas

x <- c(962, 826, 798, 600, 834, 532, 407, 484, 856, 667, 417, 541, 103, 904, 523)
g <- c("B", "B", "A", "A", "B", "B", "B", "A", "B", "B", "B", "A", "A", "A", "B")

tapply(x, g, mean)
#>        A        B 
#> 571.6667 669.3333

Kintamųjų grupavimas gali būti atliekamas pagal kelis požymius vienu metu.
Tokiu atveju argumentui INDEX perduodamas sąrašas grupavimo vektorių.

Kodas

# pirmieji 8 stebiniai – grupė I, likę 7 – grupė II
p <- rep(c("I", "II"), c(8, 7))

# sąlyginiai vidurkiai grupėse I-A, I-B, II-A, II-B
tapply(x, list(p, g), mean)
#>           A      B
#> I  627.3333 712.20
#> II 516.0000 615.75

# kiek elementų patenka į kiekvieną kombinaciją
tapply(x, list(p, g), length)
#>    A B
#> I  3 5
#> II 3 4

Į tapply() įstatomas funkcijos gali turėti savo parametrus. Pavyzdžiui, įvairios statistines charakteristikas skaičiuojančios funkcijos turi argumentą na.rm, kuriam suteikus reikšmę TRUE, praleistos duomenų reikšmės ignoruojamos.

Kodas

y <- c(962, NA, 798, 600, 834, 532, 407, 484, NA, 667, 417, 541, NA, 904, 523)
tapply(y, g, sum, na.rm = TRUE)
#>    A    B 
#> 3327 4342
tapply(y, g, mean, na.rm = TRUE)
#>        A        B 
#> 665.4000 620.2857

Jei standartinės funkcijos nėra, galima naudoti savo sukurtas arba anonimines funkcijas:

Kodas

# max – min kiekvienoje grupėje
tapply(x, g, function(v) max(v) - min(v))
#>   A   B 
#> 801 555

# tas pats, bet trumpiau funkcinio programavimo stiliumi
tapply(x, g, function(v) diff(range(v)))
#>   A   B 
#> 801 555

Funkcijoje tapply() naudojami duomenys (X ir INDEX) dažnu atveju yra paimti iš duomenų lentelės.

Kodas

d <- read.table(header = TRUE, text = "
   lytis  ugis svoris grupe
  vyras   175     76     B
  vyras   180     NA     B
moteris   170     67     A
moteris   167     64     B
  vyras   178     80     A
moteris   172     59    NA
  vyras   184     NA     A
moteris   171     68     B
moteris   177     70     A
  vyras   185     84     B
")

# ūgio vidurkis grupėse „vyras“ ir „moteris“
tapply(d$ugis, d$lytis, mean)
#> moteris   vyras 
#>   171.4   180.4

Jeigu duomenų lentelės kintamųjų vardai labai ilgi, paprasčiau juos panaudoti taikaint with() konstrukciją. Joje nurodoma aplinka, iš kurios imami kintamieji, ir vykdoma išraiška. Šiuo atveju aplinka bus duomenų lentelė, o taikoma išraiška bus funkcija, kuriai perduosime kintamuosius.

Kodas

with(data = d, tapply(ugis, lytis, mean))
#> moteris   vyras 
#>   171.4   180.4

Išskaidymas į grupes

Funkcija tapply() be parametro FUN nurodo, į kurią grupę iš INDEX patenką kiekvienas X elementas.

Kodas

tapply(x, g)
#>  [1] 2 2 1 1 2 2 2 1 2 2 2 1 1 1 2

Operatorius [ panaudotas kaip funkcija išskaido grupuotus X elementus į atskirus sąrašo elementus.

Kodas

tapply(x, g, "[")
#> $A
#> [1] 798 600 484 541 103 904
#> 
#> $B
#> [1] 962 826 834 532 407 856 667 417 523

Tačiau įprastai tokiam veiksmui atlikti yra speciali funkcija split().

Kodas

split(x, g)
#> $A
#> [1] 798 600 484 541 103 904
#> 
#> $B
#> [1] 962 826 834 532 407 856 667 417 523

Kadangi funkcijos split() rezultatas yra sąrašas, tai išvestį galima perduoti funkcijoms sapply() arba lapply() tolimesniems veiksmams su sąrašo elementais atlikti.

Kodas

sapply(split(x, g), mean)
#>        A        B 
#> 571.6667 669.3333

Užduotis

Sąlyga
Sprendimas

Naudojant tapply(), apskaičiuokite vektoriaus x sumas pogrupiuose, apibrėžtuose kintamojo p reikšmėmis.
Raskite mažiausią ir didžiausią x reikšmę kiekvienoje p grupėje.
Iš duomenų lentelės d apskaičiuokite kintamojo svoris vidurkį atskirai vyrams ir moterims.
Naudodami tapply(), iš vektoriaus x, suskirstyto pagal g, suformuokite matricas po vieną stulpelį kiekvienai grupei.
Iš kiekvienos x grupės (pagal g) išskirkite pirmuosius du elementus.
Parašykite funkciją su tapply(), kuri suskaičiuoja, kiek vektoriaus y elementų yra NA ir kiek – ne. Pakartokite tą patį nenaudodami tapply().

Kodas

# 1. 
tapply(x, p, sum)
#>    I   II 
#> 5443 4011

# 2.
tapply(x, p, range)
#> $I
#> [1] 407 962
#> 
#> $II
#> [1] 103 904

# 3.
with(d, tapply(svoris, lytis, mean, na.rm = T))
#> moteris   vyras 
#>    65.6    80.0

# 4.
tapply(x, g, matrix, ncol = 1)
#> $A
#>      [,1]
#> [1,]  798
#> [2,]  600
#> [3,]  484
#> [4,]  541
#> [5,]  103
#> [6,]  904
#> 
#> $B
#>       [,1]
#>  [1,]  962
#>  [2,]  826
#>  [3,]  834
#>  [4,]  532
#>  [5,]  407
#>  [6,]  856
#>  [7,]  667
#>  [8,]  417
#>  [9,]  523

# 5.
tapply(x, g, "[", 1:2)
#> $A
#> [1] 798 600
#> 
#> $B
#> [1] 962 826
lapply(split(x, g), "[", 1:2)
#> $A
#> [1] 798 600
#> 
#> $B
#> [1] 962 826
sapply(split(x, g), "[", 1:2)
#>        A   B
#> [1,] 798 962
#> [2,] 600 826

# 6.
tapply(y, is.na(y), length)
#> FALSE  TRUE 
#>    12     3

# yra NA
sum(is.na(y))
#> [1] 3

# nėra NA
sum(!is.na(y))    
#> [1] 12

7.2.2 Funkcija `by()`

Funkcija tapply() naudojama kitų funkcijų skaičiavimui kai duomenys yra į grupes išskaidyti vektoriaus elementai.

Funkcija by() pritaiko nurodytą funkciją (FUN) duomenų lentelės arba matricos pogrupiams, apibrėžtiems vienu ar keliais kategoriniais kintamaisiais.

Argumentas	Reikšmė
`data`	Duomenų lentelė arba matrica.
`INDICES`	Grupuojantis faktorius arba jų sąrašas.
`FUN`	Funkcija ar jos išraiška.
`simplify`	Jei `TRUE`, rezultatas gražinamas kaip vektorius.

Pačiu paprasčiausiu atveju funkcija by() naudojama lygiai taip pat kaip ir f-ja tapply(), skiriasi tik rezultatų išvedimo forma.

Kodas

by(x, g, mean)
#> g: A
#> [1] 571.6667
#> ------------------------------------------------------------ 
#> g: B
#> [1] 669.3333

Skaičiavimus galima atlikti su vienu duomenų lentelės kintamuoju. Pvz., apskaičiuosime lentelės d kintamojo ūgis vidurkį atskirai moterims ir vyrams. Čia kintamasis ūgis vidurkio skaičiavimo funkcijai perduodamas kaip vektorius.

Kodas

by(d[, 2], d[, 1],  mean)
#> d[, 1]: moteris
#> [1] 171.4
#> ------------------------------------------------------------ 
#> d[, 1]: vyras
#> [1] 180.4
by(d$ugis, d$lytis, mean)
#> d$lytis: moteris
#> [1] 171.4
#> ------------------------------------------------------------ 
#> d$lytis: vyras
#> [1] 180.4

Skaičiavimo išraišką lengviau perskaityti naudojant funkciją with().

Kodas

with(d, by(ugis, lytis, mean))
#> lytis: moteris
#> [1] 171.4
#> ------------------------------------------------------------ 
#> lytis: vyras
#> [1] 180.4

Skaičiavimus galima atlikti su daugiau nei vienu kintamuoju, pvz., skaičiuojant koreliaciją tarp ūgio ir svorio. Norint perduoti kelis kintamuosius funkcijai by(), juos reikia apjungti naudojant cbind(). Kadangi kintamasis svoris turi praleistų reikšmių, nurodomas papildomas cor() funkcijos parametras use = "complete.obs", kuris stebinių su praleistomis reikšmėmis neįtraukia į skaičiavimus.

Kodas

with(d, by(cbind(ugis, svoris), lytis, cor, use = "complete.obs"))
#> INDICES: moteris
#>             ugis    svoris
#> ugis   1.0000000 0.3974114
#> svoris 0.3974114 1.0000000
#> ------------------------------------------------------------ 
#> INDICES: vyras
#>             ugis    svoris
#> ugis   1.0000000 0.9743547
#> svoris 0.9743547 1.0000000

Rezultatas - ūgio ir svorio kintamųjų koreliacijų matricos skirtingose lyties grupėse.

Vietoje naudojimo cbind() kai perduodami keli kintamieji, galima perduoti funkcijai by() tik dalį duomenų lentelės, t.y. tik tuos kintamuosius, kurie reikalingi skaičiavimuose. Tokiu būdu paskutinė taikyta išraiška sutrumpėja.

Kodas

by(d[2:3], d[1], cor, use = "complete.obs")
#> lytis: moteris
#>             ugis    svoris
#> ugis   1.0000000 0.3974114
#> svoris 0.3974114 1.0000000
#> ------------------------------------------------------------ 
#> lytis: vyras
#>             ugis    svoris
#> ugis   1.0000000 0.9743547
#> svoris 0.9743547 1.0000000

Užduotis

Sąlyga
Sprendimas

Naudodami duomenų lentelę d, funkciją by() ir colMeans(), apskaičiuokite ūgio ir svorio vidurkius atskirai vyrams ir moterims.
Duomenų rinkinyje airquality apskaičiuokite, kiek NA reikšmių yra stulpelyje Ozone kiekvieną mėnesį. Pabandykite abu būdus: su by() ir su tapply().
Naudodami by() ir airquality duomenis, kiekvienam mėnesiui apskaičiuokite ozono (Ozone) ir temperatūros (Temp) vidurkį. Kurį mėnesį buvo šilčiausia ir didžiausias ozono kiekis?

Kodas

# 1. 
by(d[2:3], d$lytis, colMeans, na.rm = T)
#> d$lytis: moteris
#>   ugis svoris 
#>  171.4   65.6 
#> ------------------------------------------------------------ 
#> d$lytis: vyras
#>   ugis svoris 
#>  180.4   80.0

# 2.
tapply(airquality$Ozone, airquality$Month, function(x) sum(is.na(x)))
#>  5  6  7  8  9 
#>  5 21  5  5  1
by(airquality$Ozone, airquality$Month, function(x) sum(is.na(x)))
#> airquality$Month: 5
#> [1] 5
#> ------------------------------------------------------------ 
#> airquality$Month: 6
#> [1] 21
#> ------------------------------------------------------------ 
#> airquality$Month: 7
#> [1] 5
#> ------------------------------------------------------------ 
#> airquality$Month: 8
#> [1] 5
#> ------------------------------------------------------------ 
#> airquality$Month: 9
#> [1] 1

with(airquality, tapply(is.na(Ozone), Month, sum))
#>  5  6  7  8  9 
#>  5 21  5  5  1
with(airquality, by(is.na(Ozone), Month, sum))
#> Month: 5
#> [1] 5
#> ------------------------------------------------------------ 
#> Month: 6
#> [1] 21
#> ------------------------------------------------------------ 
#> Month: 7
#> [1] 5
#> ------------------------------------------------------------ 
#> Month: 8
#> [1] 5
#> ------------------------------------------------------------ 
#> Month: 9
#> [1] 1

# 3.
by(airquality[c("Ozone", "Temp")], airquality$Month, colMeans, na.rm = T)
#> airquality$Month: 5
#>    Ozone     Temp 
#> 23.61538 65.54839 
#> ------------------------------------------------------------ 
#> airquality$Month: 6
#>    Ozone     Temp 
#> 29.44444 79.10000 
#> ------------------------------------------------------------ 
#> airquality$Month: 7
#>    Ozone     Temp 
#> 59.11538 83.90323 
#> ------------------------------------------------------------ 
#> airquality$Month: 8
#>    Ozone     Temp 
#> 59.96154 83.96774 
#> ------------------------------------------------------------ 
#> airquality$Month: 9
#>    Ozone     Temp 
#> 31.44828 76.90000
with(airquality, by(cbind(Ozone, Temp), Month, colMeans, na.rm = T))
#> INDICES: 5
#>    Ozone     Temp 
#> 23.61538 65.54839 
#> ------------------------------------------------------------ 
#> INDICES: 6
#>    Ozone     Temp 
#> 29.44444 79.10000 
#> ------------------------------------------------------------ 
#> INDICES: 7
#>    Ozone     Temp 
#> 59.11538 83.90323 
#> ------------------------------------------------------------ 
#> INDICES: 8
#>    Ozone     Temp 
#> 59.96154 83.96774 
#> ------------------------------------------------------------ 
#> INDICES: 9
#>    Ozone     Temp 
#> 31.44828 76.90000

7.2.3 Funkcija `aggregate()`

Kaip ir funkcija by(), funkcija aggregate() duomenų lentelę pagal vieno ar keletos kategorinių kintamųjų reikšmes suskirsto į grupes. Pagrindinis skirtumas toks, kad skaičiavimams perduodama ne duomenų lentelė, tačiau ją sudarančių kitamųjų rinkinys. Dėl to funkcija aggregate() dažniausiai naudojama atskirų kintamųjų tų pačių skaitinių charakteristikų skaičiavimui ir šiuo požiūriu labiau panaši į funkciją tapply().

Matematiniu požiūriu, galima sakyti, kad by() taiko kelių kintamųjų funkciją visam duomenų pogrupiui kaip objektui – tai atitinka \(f(x, y)\), kai keli kintamieji perduodami vienu metu ir galima analizuoti jų tarpusavio sąryšius. Tuo tarpu aggregate() funkciją taiko kiekvienam kintamajam atskirai – tai labiau atitinka vieno kintamojo funkcijas \(f(x), f(y)\), kai kiekvieno stulpelio charakteristikos skaičiuojamos atskirai, nepriklausomai.

Aišku, taikomos funkcijos vykdomos kiekvienoje iš nurodytų grupių atskirai.

Argumentas	Reikšmė
`X`	Duomenų vektorius, matrica arba lentelė.
`by`	Sąrašas, su duomenis grupuojančiais vektoriais.
`FUN`	Kiekvienai grupei taikoma funkcija.

Pavyzdžiui, apskaičiuosime vektoriaus x vidurkius grupėse g.

Kodas

aggregate(x, list(g), mean)
#>   Group.1        x
#> 1       A 571.6667
#> 2       B 669.3333

Galima naudoti ne vieną grupavimo kintamąjį ir ne vieną duomenų vektorių. Pvz., aspkaičiuosime ūgio ir svorio iš lentelės d vidurkius pagal lytį ir stebinių grupę. Kadangi kiekybiniai kintamieji turi praleistų reikšmių, papildomai nurodome funkcijos mean() parametrą na.rm = TRUE.

Kodas

rez <- aggregate(d[, 2:3], list(d[, 1], d[, 4]), mean, na.rm = TRUE)

Atkreipkite dėmesį, kad funkcijos aggregate() grąžinamas rezultatas yra duomenų lentelės klasės objektas.

Kodas

class(rez)
#> [1] "data.frame"

Funkcija aggregate() leidžia duomenų skaidymą skaičiavimui grupėse užrašyti formule. Šiuo atveju keičiasi funkcijos parametrai.

Argumentas	Reikšmė
`formula`	Duomenų suskaidymo formulė.
`data`	Duomenų lentelės vardas.
`FUN`	Kiekvienai grupei taikoma funkcija.
`subset`	Išraiška, kuri nurodo duomenų lentelės poaibį (eilutes).
`na.action`	Veiksmas su `NA` reikšmėmis, pagal nutylėjimą `na.omit` - NA reikšmės pašalinamos.

Funkcijos aggregate() užrašymas formule gali būti patogesnis, nes esminis skirtumas tarp tokio ir įprasto užrašymo yra galimybė tiesiogiai naudoti kintamųjų vardus formulėje, kai parametre data nurodomas duomenų šaltinis.

Žinoma, čia svarbu mokėti užrašyti ir suprasti skaidymo formulę. Žemiau pateikiami formulės užrašymo variantai:

y ~ A - kintamasis y suskaidomas į grupes pagal kintamojo A reikšmes,
y ~ A + B - kintamasis y suskaidomas į grupes pagal kintamųjų A ir B reikšmes,
cbind(y, x) ~ A - kintamieji y ir x suskaidomi į grupes pagal kintamojo A reikšmes,
. ~ A - visi lentelės kintamieiji suskaidomi į grupes pagal kintamojo A reikšmes,
y ~ . - kintamasis y suskaidomas į grupes pagal visus likusius lentelės kintamuosius.

Naudodami funkcijos sintaksę su formule, apskaičiuosime vektoriaus x vidurkius grupėse pagal vektorių g. Kadangi vektoriai ne iš duomenų lentelės, parametro data nurodyti nereikia.

Kodas

aggregate(x ~ g, FUN = mean)
#>   g        x
#> 1 A 571.6667
#> 2 B 669.3333

Apskaičiuosime kintamojo ūgis iš duomenų lentelės d vidurkį pagal lytį. Šį kartą suskaidymą į grupes užrašysime formule.

Kodas

aggregate(ugis ~ lytis, data = d, FUN = mean)
#>     lytis  ugis
#> 1 moteris 171.4
#> 2   vyras 180.4

Apskaičiuosime ūgio ir svorio iš lentelės d vidurkį grupėse pagal kategorinius kintamuosius lytį ir grupę. Kairėje formulės pusėje esančius kintamuosius reikia apjungti į vieną lentelę. Tam naudojama komanda cbind().

Kodas

aggregate(cbind(ugis, svoris) ~ lytis + grupe, data = d, FUN = mean)
#>     lytis grupe  ugis svoris
#> 1 moteris     A 173.5   68.5
#> 2   vyras     A 178.0   80.0
#> 3 moteris     B 169.0   66.0
#> 4   vyras     B 180.0   80.0

Kadangi abu kintamieji lytis ir grupė yra kategoriniai, o kitų kintamųjų nėra, juos galima pakeisti tašku. Čia reikia suprasti, kad ūgis ir svoris grupuojami pagal visus likusius lentelės d kintamuosius.

Kodas

aggregate(cbind(ugis, svoris) ~ ., data = d, FUN = mean)
#>     lytis grupe  ugis svoris
#> 1 moteris     A 173.5   68.5
#> 2   vyras     A 178.0   80.0
#> 3 moteris     B 169.0   66.0
#> 4   vyras     B 180.0   80.0

Tą patį galima padaryti ir su kitų dviejų kintamųjų pora. Toks užrašymo būdas patogus, jei suskaidymą reikia atlikti daugeliui kintamųjų iš karto, nes šiuo atveju nereikia rašyti jų visų vardų.

Kodas

aggregate(. ~ lytis + grupe, data = d, FUN = mean)
#>     lytis grupe  ugis svoris
#> 1 moteris     A 173.5   68.5
#> 2   vyras     A 178.0   80.0
#> 3 moteris     B 169.0   66.0
#> 4   vyras     B 180.0   80.0

Galima naudoti loginę sąlygą, kad skaičiavimai būtų atliekami tik su tam tikromis eilutėmis. Pvz., nurodysime, kad skaičiavimus atlikti reikia tik su eilutėmis, kuriuose svoris mažesnis nei 80 kg.

Kodas

aggregate(ugis ~ lytis, data = d, subset = svoris < 80, FUN = mean)
#>     lytis  ugis
#> 1 moteris 171.4
#> 2   vyras 175.0

Užduotis

Sąlyga
Sprendimas

Lentelėje chickwts pateikti viščiukų svoriai (weight) ir pašarų tipai (feed). Apskaičiuokite vidutinius viščiukų svorius kiekvienam pašaro tipui naudodami:

• aggregate() be ir su formule;

• tą patį rezultatą gauti su tapply() arba by().
Duomenų rinkinyje airquality apskaičiuokite kiekvieno mėnesio vidutinę temperatūrą. Naudokite tam aggregate() ir tapply().
Naudodami duomenų rinkinį iris, apskaičiuokite:

• kiekvienos rūšies (Species) žiedlapių (Petal) ilgio ir pločio medianas.

• visų kiekybinių kintamųjų vidurkius pagal rūšį.

Kodas

# 1. 
# įprastas užrašymas
aggregate(x = chickwts$weight, by = list(chickwts$feed), mean)
#>     Group.1        x
#> 1    casein 323.5833
#> 2 horsebean 160.2000
#> 3   linseed 218.7500
#> 4  meatmeal 276.9091
#> 5   soybean 246.4286
#> 6 sunflower 328.9167

# naudojant formulę
aggregate(weight ~ feed, data = chickwts, mean)
#>        feed   weight
#> 1    casein 323.5833
#> 2 horsebean 160.2000
#> 3   linseed 218.7500
#> 4  meatmeal 276.9091
#> 5   soybean 246.4286
#> 6 sunflower 328.9167

# su tapply()
tapply(chickwts$weight, chickwts$feed, mean)
#>    casein horsebean   linseed  meatmeal   soybean sunflower 
#>  323.5833  160.2000  218.7500  276.9091  246.4286  328.9167

# su by()
by(chickwts$weight, chickwts$feed, mean)
#> chickwts$feed: casein
#> [1] 323.5833
#> ------------------------------------------------------------ 
#> chickwts$feed: horsebean
#> [1] 160.2
#> ------------------------------------------------------------ 
#> chickwts$feed: linseed
#> [1] 218.75
#> ------------------------------------------------------------ 
#> chickwts$feed: meatmeal
#> [1] 276.9091
#> ------------------------------------------------------------ 
#> chickwts$feed: soybean
#> [1] 246.4286
#> ------------------------------------------------------------ 
#> chickwts$feed: sunflower
#> [1] 328.9167


# 2. 
aggregate(Temp ~ Month, data = airquality, mean)
#>   Month     Temp
#> 1     5 65.54839
#> 2     6 79.10000
#> 3     7 83.90323
#> 4     8 83.96774
#> 5     9 76.90000
tapply(airquality$Temp, airquality$Month, mean)
#>        5        6        7        8        9 
#> 65.54839 79.10000 83.90323 83.96774 76.90000

# 3. 
aggregate(cbind(Petal.Length, Petal.Width) ~ Species, data = iris, median)
#>      Species Petal.Length Petal.Width
#> 1     setosa         1.50         0.2
#> 2 versicolor         4.35         1.3
#> 3  virginica         5.55         2.0

aggregate(. ~ Species, data = iris, mean)
#>      Species Sepal.Length Sepal.Width Petal.Length Petal.Width
#> 1     setosa        5.006       3.428        1.462       0.246
#> 2 versicolor        5.936       2.770        4.260       1.326
#> 3  virginica        6.588       2.974        5.552       2.026

7.0.1 Funkcijos argumentai

7.0.2 Funkcijos grąžinamas objektas

7.0.3 Kodo nuskaitymas iš tekstinio failo

7.0.4 Korektiškų funkcijų užrašymas

Funkcijos stop() ir stopifnot()

Funkcijos message() ir warning()

7.0.5 switch teiginys

7.1 apply funkcijų šeima

7.1.1 Funkcija apply()

7.1.2 Funkcijos lapply() ir sapply()

7.1.3 Funkcija mapply()

7.2 Funkcijos skaičiavimas grupėse

7.2.1 Funkcija tapply()

7.2.2 Funkcija by()

7.2.3 Funkcija aggregate()

Funkcijos `stop()` ir `stopifnot()`

Funkcijos `message()` ir `warning()`

7.0.5 `switch` teiginys

7.1.1 Funkcija `apply()`

7.1.2 Funkcijos `lapply()` ir `sapply()`

7.1.3 Funkcija `mapply()`

7.2.1 Funkcija `tapply()`

7.2.2 Funkcija `by()`

7.2.3 Funkcija `aggregate()`