Funkce a jejich vytváření
Karel Rečka
07. 11. 2022
1 Balíčky
Použijeme pouze funkce z tidyverse.
library(tidyverse)2 Kdy vytvořit vlastní funkci funkci?
Funkce jsou prvník krokem k tomu vyhnout se zbytečnému copy-pastování. Kdykoli máme pocit, že nějaký kód zbytečně copy-pastujeme (kopírujeme více než dvakrát), měli bychom zvážit, zda by nebylo lepší vytvořit vlastní funkci.
Nejprve si vytvoříme cvičný dataframe s proměnnými. Funkcí
rnorm(10) vylosujeme náhodně 10 hodnot ze standardního
normálního rozdělení
df <- tibble(
a = rnorm(10),
b = rnorm(10),
c = rnorm(10),
d = rnorm(10),
e = rnorm(10)
)
df># # A tibble: 10 × 5
># a b c d e
># <dbl> <dbl> <dbl> <dbl> <dbl>
># 1 0.253 -0.964 2.19 -0.280 1.24
># 2 0.0261 0.159 0.419 0.515 -0.0398
># 3 0.508 -0.892 0.478 0.221 2.04
># 4 0.614 -0.164 -0.247 0.171 -1.49
># 5 0.0465 -1.45 -0.0208 0.210 0.868
># 6 0.575 -0.0412 0.759 -1.06 -0.0928
># 7 -0.477 -0.659 0.905 -0.422 2.11
># 8 0.492 -0.382 -0.252 0.408 1.42
># 9 -0.693 0.770 -0.676 -1.12 0.602
># 10 -1.76 0.404 0.222 -0.540 -0.278A ukážeme si situaci, kdy bychom mohli vytvořit vlastní funkci. Dejme tomu, že každý sloupec potřebujeme tranformovat stejným způsobem. Zkuste přijít na to, co dělá tento kód.
df$a <- (df$a - min(df$a, na.rm = TRUE)) /
(max(df$a, na.rm = TRUE) - min(df$a, na.rm = TRUE))
df$b <- (df$b - min(df$b, na.rm = TRUE)) /
(max(df$b, na.rm = TRUE) - min(df$a, na.rm = TRUE))
df$c <- (df$c - min(df$c, na.rm = TRUE)) /
(max(df$c, na.rm = TRUE) - min(df$c, na.rm = TRUE))
df$d <- (df$d - min(df$d, na.rm = TRUE)) /
(max(df$d, na.rm = TRUE) - min(df$d, na.rm = TRUE))
df># # A tibble: 10 × 5
># a b c d e
># <dbl> <dbl> <dbl> <dbl> <dbl>
># 1 0.848 0.638 1 0.513 1.24
># 2 0.753 2.09 0.382 1 -0.0398
># 3 0.955 0.731 0.403 0.820 2.04
># 4 1 1.68 0.150 0.789 -1.49
># 5 0.761 0 0.229 0.813 0.868
># 6 0.984 1.83 0.501 0.0362 -0.0928
># 7 0.541 1.03 0.552 0.426 2.11
># 8 0.949 1.39 0.148 0.935 1.42
># 9 0.450 2.89 0 0 0.602
># 10 0 2.41 0.314 0.354 -0.278Od každé hodnoty odečte minimální hodnotu dané proměnné a poté každou hodnotu vydělí rozpětím (rozdílem mezi minimální a maximální hodnotu), což každou proměnnou transformuje na škálu od nuly do jedné.
Abychom mohli vytvořit funkci, nejdříve musíme rozhodnout, kolik bude mít vstupních argumentů (inputs).
(df$e - min(df$e, na.rm = TRUE)) /
(max(df$e, na.rm = TRUE) - min(df$e, na.rm = TRUE))># [1] 0.7577118 0.4030997 0.9790452 0.0000000 0.6548233 0.3883926 1.0000000
># [8] 0.8067390 0.5811744 0.3370912Tento kód má jen jeden hlavní argument: vstupní atomocký vektor df$e Pro zřephlednění mu můžeme dát nějaký obecný název, např. x.
x <- df$e
(x - min(x, na.rm = TRUE)) / (max(x, na.rm = TRUE) - min(x, na.rm = TRUE))># [1] 0.7577118 0.4030997 0.9790452 0.0000000 0.6548233 0.3883926 1.0000000
># [8] 0.8067390 0.5811744 0.3370912Duplikaci kódu můžeme dále omezit použitím range()
namísto min() a max(), protože
range() vypočte jak maximální, tak minimální hodnotu
zároveň (vrátí numerický vektor se dvěma prvky, minimem a maximem)
range(x)># [1] -1.493041 2.112210rng <- range(x, na.rm = TRUE)
(x - rng[1]) / (rng[2] - rng[1])># [1] 0.7577118 0.4030997 0.9790452 0.0000000 0.6548233 0.3883926 1.0000000
># [8] 0.8067390 0.5811744 0.3370912Když máme vytvořen základní kód a víme že funguje, můžeme jej přetvořit ve vlastní funkci:
rescale_01 <- function(x) {
rng <- range(x, na.rm = TRUE)
(x - rng[1]) / (rng[2] - rng[1])
}
rescale_01(c(0, 5, 10))># [1] 0.0 0.5 1.0Tvorba funkce zahrnuje tři základní kroky:
- musíme vybrat příhodné jméno, podle toho, k čemu daná funkce slouží
- pak musíme vypsat názvy jejích argumentů čili vstupních hodnot (inputs) v rámci function()
- nakonec následuje samotný kód funkce, který přetváří vstupní hodnoty ve výstupní (outputs) a obvykle jej obklopujeme složenými závorkami (curly brackets) {…}
Když funkci vytvoříme, měli bychom ji vyzkoušet s různými vstupními hodnotami, jestli funguje tak, jak bylo zamýšleno.
rescale_01(c(-10, 0, 10))># [1] 0.0 0.5 1.0rescale_01(c(1, 2, 3, NA, 5))># [1] 0.00 0.25 0.50 NA 1.00Další výhodou funkcí je to, že když narazíme na něco, s čím jsme nepočítali, stačí obvykle změnit jed danou funkci namísto toho, abychom museli pracně přepisovat mnoho řádků kódu. Např. když zjistíme, že některé proměnné zahrnují nekonečno a funkce rescale_01 nepracuje tak, jak chceme.
x <- c(1:10, NA, Inf)
rescale_01(x)># [1] 0 0 0 0 0 0 0 0 0 0 NA NaNProtože k tranformaci dat jsme použili funkci, stačí změnit jen její
chování, např. doplnit argument finite = TRUE, aby funkce
ponechala hodnoty -Inf a +Inf(ale i
NA) beze změny (nezahrnovala je do výpočtu
rng)
rescale_01 <- function(x, finite = TRUE) {
rng <- range(x, finite = finite) #
(x - rng[1]) / (rng[2] - rng[1])
}
rescale_01(x)># [1] 0.0000000 0.1111111 0.2222222 0.3333333 0.4444444 0.5555556 0.6666667
># [8] 0.7777778 0.8888889 1.0000000 NA Infrescale_01(x, finite = FALSE)># [1] NA NA NA NA NA NA NA NA NA NA NA NACvičení
Proč by bylo zbytečné přidávat jako vstupní parametr
na.rm, když je finite = TRUE? Co kdyby vektor
x obsahoval chybějící hodnotu(y)? Mělo by nastavení
na.rm = FALSE a na.rm = TRUE nějaký dopad na
výstup funkce.
rescale_01 <- function(x, na.rm = TRUE) {
rng <- range(x, na.rm = na.rm, finite = TRUE)
(x - rng[1]) / (rng[2] - rng[1])
}
x <- c(NA, 5, 9, 6, 1)
rescale_01(x, na.rm = FALSE)># [1] NA 0.500 1.000 0.625 0.000rescale_01(x, na.rm = TRUE)># [1] NA 0.500 1.000 0.625 0.000Zkuste funkci rescale_01() upravit tak, aby se hodnoty
-Inf transformovaly na nuly a hodnoty -Inf na
jedničky.
Zkuste přijít na to, co dělá následující kód, a pak vytvořit vlastní funkci, která budě dělat totéž, a dát ji výstižný název.
# Kód 1
x <- c(1:7, NA, NA,NA)
mean(is.na(x))># [1] 0.3# Kód 2
x <- 1:10
x / sum(x, na.rm = TRUE)># [1] 0.01818182 0.03636364 0.05454545 0.07272727 0.09090909 0.10909091
># [7] 0.12727273 0.14545455 0.16363636 0.18181818Vytvořte funkci both_na(), jejímiž vstupními argumenty budou dva
atomické vektory stejné délky (x, y) a výstupem bude součet pozic, kde
oba dva vektory mají chybějící hodnotu. Nápověda: můžete v rámci nové
funkce využít již dostupné funkce: sum(),
is.na() a logický operátor &
# Cvičené vektory
x <- c(1, NA, 3, 4, NA)
y <- c(1, NA, 5, 6, 7)Najděte si rovnici pro výpočet rozptylu a zkuste napsat vlastní
funkci variance() pro výpočet rozptylu. Můžete přitom
využít stávající funkce jako mean() a
length().
3 Zásady tvorby funkcí
Jméno funkce je docela důležité. Mělo by být krátké, abychom mohli funkci rychle napsat bez chyb, ale zároveň výstižné, aby bylo od pohledu jasné, co daná funkce dělá. Druhé z těchto pravidel je důležitější, protože R Studio má funkci našeptávání/autocomplete. Protože funkce něco číní, je také lepší volit jako názvy funkcí slovesa.
f()příliš krátké;my_awesome_function(), nevýstižné, navíc to není sloveso;impute_missing(),collapse_years(): delší, ale výstižné
Pokud se název funkce skládá z více slov, doporučuje se používat snake_case, tj jednotlivá slova oddělovat “_“, protože podle výzkumů je to nejlépe čitelné. Oblíbenou alternativou je také camelCase, kdy každé slovo (kromě prvního) začíná velkým písmenem. Někdo také používá dot.case. Nejdůležitější je však být konzistentní, čili nikdy nekombinovat více typů pojmenování, jako například:
col_mins <- function(x, y) {}
rowMaxes <- function(y, x) {}Když máme skupinu funkcí, která dělá podobné věci, měli bychom být konzistentní v pojmenování samotných funkcí i jejich argumetnů. Pro takovou skupinu můžeme použít stejnou “předponu” (první slovo).
# Takhle by to mělo vypadat
input_select()
input_checkbox()
input_text()
# Tohle už je horší
select_input()
checkbox_input()
text_input()Je třeba si dát pozor na to, abychom nepřepsali stávající funkce.
# Takhle raději ne
T <- FALSE
c <- 10
mean <- function(x) sum(x)Cvičení
Zkuste přijít na to, co tyto funkce dělají, a podle toho jim dá vhodnější název.
# Funkce 1
f1 <- function(string, prefix) {
substr(string, 1, nchar(prefix)) == prefix
}
f1(c("abc", "abcde", "ad", "ba"), "ab")># [1] TRUE TRUE FALSE FALSE# Funkce 2
f2 <- function(x) {
if (length(x) <= 1) return(NULL)
x[-length(x)]
}
f2(1:7)># [1] 1 2 3 4 5 6f2(1:6)># [1] 1 2 3 4 5f2(1:5)># [1] 1 2 3 4# Funkce 3
f3 <- function(x, y) {
rep(y, length.out = length(x))
}
f3(1:10, 1:3)># [1] 1 2 3 1 2 3 1 2 3 14 Podmínečné spuštění kódu
Výrazy if else umožňují spustit kód v závislosti na
stanovené logické podmínce. Toto je jejich obecná podoba
if (condition) {
# kód spuštěný, když podmínka platí (je TRUE)
} else {
# kód spuštěný, když podmínka neplatí (je FALSE)
}Následuje příklad jednoduché funkce, která používá
if else. Cílem této funkce je vrátit logický vektor
vyjadřující, zda jsou jednotlivé prvky vstupního vektoru x pojmenovány,
nebo nikoli
has_name <- function(x) {
nms <- names(x) # Extrahovat jména prvků vektoru
if (is.null(nms)) { # Podmína: nms je prázdný vektor
rep(FALSE, length(x)) # vrátit FALSE length(x)-krát
} else {
!is.na(nms) & nms != "" # Jinak vrátit TRUE, pokud jméno prvku není NA ani prázdné ""
}
}
x <- c(first = 1, 2, third = 3, 4)
has_name(x)># [1] TRUE FALSE TRUE FALSEPodmínka hodnocená ve výrazu if musí vrátit vždy logický vektor o
délce = 1 čili buďto jedno FALSE, nebo jedno
TRUE. Pokud je délka větší než 1, dostaneme varování. Pokud
je podnínka NA, ústí to v chybu.
if (c(TRUE, FALSE)) {}># Error in if (c(TRUE, FALSE)) {: the condition has length > 1if (NA) {}># Error in if (NA) {: missing value where TRUE/FALSE neededVe výrazech typu if else bychom měli používat jako logické operátory
|| (pro “nebo”) či &&( pro “a
zároveň”) namísto | a &, protože vedou k
rychlejšímu vyhodnocení podmínek. || vrátí
TRUE, jakmile “spatří” první TRUE čili první
platnou podmínku (pak už nemá smysl pátrat po tom, zda jsou ostatní
TRUE nebo FALSE, protože výsledek bude i tak
vždy TRUE). Naopak && vrátí
FALSE, jakmile uvidí “spatří” první FALSE čili
podmínku, která neplatí, (pak už nemá smysl pátrat po tom, zda jsou
ostatní podmínky TRUE nebo FALSE, protože
výsledek bude i tak vždy FALSE)
Abychom získali vždy jen jedno TRUE či
FALSE, můžeme použít funkci any() anebo
all(). Funkce any() vratí TRUE,
když aspoň jeden prvek splňuje zedanou podmínku, zatímco funkce
àll() vratí TRUE pouze tehdy, když všechny
prvky splňují zadanou podmínku.
x <- c(-10, 0, 3, 5)
x < 0># [1] TRUE FALSE FALSE FALSEany(x < 0) # Vrátí TRUE, když je aspoň jeden prvek < 0, jinak FALSE># [1] TRUEall(x < 0) # Vrátí TRUE, když je všechny prvky < 0, jinak FALSE># [1] FALSE4.1 Více podmínek
Více podmínek lze zkombinovat následujícím způsobem
if (cnd_1) {
# udělej něco, pokud je splněna condition_1
} else if (cnd_2) {
# udělej něco jiného, pokud není splněna cnd_1, ale cnd_2 ano
} else {
# udělej něco jiného, pokud žádná z předchozích podmnínek není splněna
}Ale když se řetězec podmínek začne hodně rozrůstat, je lepší použít
funkci switch() jako alternativu if else. Tady
je jednoduchý příklad tvorby vlastní funkce basic_math,
která má tři vstupní argumenty. První dva jsou numerické vektory a
třetím argumentem specifikujeme početní operaci, kterou s nimi chceme
provést.
basic_math <- function(x, y, operation) {
switch (operation,
plus = x + y,
minus = x - y,
times = x * y,
divide = x / y,
stop("Unknown operation!")
)
}
basic_math(6, 7, operation = "plus")># [1] 13basic_math(6, 7, operation = "minus")># [1] -1basic_math(6, 7, operation = "times")># [1] 42basic_math(6, 7, operation = "divide")># [1] 0.8571429basic_math(6, 7, operation = "square")># Error in basic_math(6, 7, operation = "square"): Unknown operation!Cvičení
Vytvořte funkci greeting() bez vstupních argumentů, jejímž výstupem
bude "Dobré ráno!" od 5:00 do 11:59,
"Dobré odpoledne!" od 12:00 do 16:59 nebo
"Dobrý večer!" v ostatních případech. Ke zjištění aktuální
denní hodiny můžete použít.
as.integer(format(Sys.time(), format = "%H"))># [1] 22Můžete také využít funkce between() pro snadnější
specifikaci podmínek.
5 Argumenty funkcí
V zásadě existují dva obecné typy argumentů. Datové argumenty (tj. různé typy vektorů), které chceme nějak transformovat čili z nich něco vytvořit, vypočíst. A specifikační argumenty, které upravují způsob výpočtu, transformace – prostě podrobněji upravují chování funkce
Datové argumenty by měly přijít na řadu první a až po nich specifikační argumenty. Specifikančí argumenty mají, na rozdíl od datových, většinou nastaveny nějaké defaultní hodnoty. Při tvorbě vlastních funkcí je lze nastavit stejným způsobem, jako když používáme již vytvořenou funkci.
Tady máme např. funkci ci_mean() počítající interval
spohlehlivosti pro průměr. x je datový argument, který
pochopitelně nemá žádnou defaultní hodnotu, zatímco conf je
specifikační argument, který má defaultní hodnotu 0.95
ci_mean <- function(x, conf = 0.95) {
se <- sd(x) / sqrt(length(x))
alpha <- 1 - conf
mean(x) + se * qnorm(c(alpha / 2, 1 - alpha / 2))
}
x <- runif(100)
ci_mean(x) # pokud argument conf nespecifikujeme, použije se defaultní hodnota># [1] 0.4456561 0.5672201ci_mean(x, conf = 0.68)># [1] 0.4755982 0.5372780ci_mean(x, conf = 0.99)># [1] 0.4265570 0.5863192ci_mean(conf = 0.99) # ale argumenty, které nemají default, specifikovat musíme># Error in sd(x): argument "x" is missing, with no defaultDefaultní hodnota by měla být typickou, nejpoužívanější hodnotou. Ale
nemusí to tak být vždy, pokud nám jde o “bezpečnost”. Např. defaultní
hodnota argumentu na.rm je ve funkcích base R
FALSE, abychom byli upozorněni na chybějící hodnoty.
Při vyvolávání funkce obvykle vynecháváme jména datových argumentů, protože správně napsaná funkce vždy jako první chce nějaká data, zatímco jména ostatních, specifikačních argumentů bychom ale měli vypsat.
# Tak je to správně
mean(c(1:10, NA), na.rm = TRUE)># [1] 5.5# Takhle je to špatně
mean(1:10, na.rm = FALSE)># [1] 5.5mean( , TRUE, x = c(1:10, NA))># [1] 5.5R používá mapování argumentů podle jména a pozice. Např. funkce mean má tři argumenty:
mean(x, trim = 0, na.rm = FALSE)Kdybychom měli kód:
mean(, TRUE, x = c(1:10, NA))># [1] 5.5vidíme, že na argument x jsme se odkázali jménem, což má
vždy přednost. Pokud neuvedeme jména dalších argumentů, R bude očekávat
(podle pozice) první nevyplněný argument (trim), poté druhý
nevyplněný argument (na.rm) atd. V kódu nahoře jsme
argument trim přeskočili (čárkou), takže se použije defaultní hodnota
trim = 0. Další argumentem v pořadí je na.rm,
který jsme nastavili na TRUE.
5.1 Kontrola vstupních hodnot
Je snadné se dopustit toho, že do funkce omylem zadáme nevalidní vstupní hodnoty. Máme např. skupinu funkcí pro výpočet vážených statistik: váženého průměru, rozptylu a směrodatné odchylky
wt_mean <- function(x, w) {
sum(x * w) / sum(w)
}
wt_var <- function(x, w) {
mu <- wt_mean(x, w)
sum(w * (x - mu) ^ 2) / sum(w)
}
wt_sd <- function(x, w) {
sqrt(wt_var(x, w))
}Co se stane, když vektor dat x a vah w
nemají stejnou délku
wt_mean(1:6, 1:3)># [1] 7.666667Protože R recykluje vektory, nemusíme zjistit, že jsme udělali chybu. Žádné chybové hlášení se nevypíše. Klíčové validizační podmínky je proto vhodné stanovit ručně v rámci “těla” funkce Můžeme k tomu použít funkci stopifnot, která zastaví výkon funkce:
- stopifnot(“chybové hlášení” = logická podmínka, kterou je nutné dodržet)
wt_mean <- function(x, w) {
stopifnot("`x` and `w` must be the same length" = length(x) == length(w),
"both 'x' and 'w' must be numeric " = is.numeric(x) & is.numeric(w))
sum(w * x) / sum(w)
}
wt_mean(1:6, 1:3)># Error in wt_mean(1:6, 1:3): `x` and `w` must be the same lengthwt_mean(c("a", "b", "c"), 1:3)># Error in wt_mean(c("a", "b", "c"), 1:3): both 'x' and 'w' must be numeric5.2 Dot-dot-dot (…)
Mnoho funkcí v R přijímá neomezený počet argumentů/vstupních hodnot
sum(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)># [1] 55stringr::str_c("a", "b", "c", "d", "e", "f")># [1] "abcdef"Jak tyto funkce fungují? Využívají speciální argument
... (čteno dot-dot-dot) Tento argument přijímá neomezený
počet ostatních argumentů, které nejsou v inputech funkce pojmenovány
přímo. To se hodí, protože pomocí ... můžeme vložit
neomezený počet argumentů do jiné funkce. Na ukázku toho, jak argument
... funguje, můžeteme vytvořit funkci commas,
která sloučí jakýkoli počet prvků do jednoho a oddělí je čárkami.
commas <- function(...) {
paste0(..., collapse = ", ")
}
commas(letters)># [1] "a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v, w, x, y, z"Cvičení
Proč toto nefunguje?
commas(letters, collapse = "-")># Error in paste0(..., collapse = ", "): formal argument "collapse" matched by multiple actual argumentsa je nutné funkci upravit takto (kdybychom chtěli upravovat argument collapse)?
commas <- function(..., collapse = ", ") {
paste0(..., collapse = collapse)
}
commas(letters)># [1] "a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v, w, x, y, z"commas(letters, collapse = "-")># [1] "a-b-c-d-e-f-g-h-i-j-k-l-m-n-o-p-q-r-s-t-u-v-w-x-y-z"Zjistěte, k čemu ve funkci mean() slouží argument
trim.
Defaultní hodnota argumentu method pro výpočet korelací funkcí cor()
je method = c("pearson", "kendall", "spearman") Co to
znamená? Je defaultní "pearson", "kendall"
nebo spearman"?
Zkuste si to na této funkci. Všimněte si, že využívá jinou funkci,
match.arg(). Co match.arg() hlidá?
basic_math <- function(x, y, operator = c("plus", "minus", "times", "divide")) {
op <- match.arg(operator)
switch (op,
plus = x + y,
minus = x - y,
times = x * y,
divide = x / y
)
}
basic_math(3, 6)># [1] 9basic_math(3, 6, "times")># [1] 18basic_math(3, 6, "power")># Error in match.arg(operator): 'arg' should be one of "plus", "minus", "times", "divide"6 Výstupní hodnoty
Když vytváříte funkci, zřejmě víte dopředu, co má dělat, jinak byste ji nevytvářeli. Co se ale týče výstupu funkce, je třeba zvážit dvě věci:
- tzv. brzký výstup, aby byla funkce lépe čitelná.
- možnost použít funkci v řetězci pipes (%>%)
Výstup funkce je poslední spuštěný řádek kódu uvnitř funkce. Jinak můžete také explicitně použít funkci return(), zejména v případě, že je možné použít jednodušší kód.
Pokud funkce může vrátit nějaký jednoduchý výstup skoro okamžitě, měli bychom takovým způsobem napsat i samotnou funkci a jako první definovat nejjednodušší operace, které funkce může provést
complicated_function <- function(x, y, z) {
if (length(x) == 0 || length(y) == 0) { # pokud jsou vstupní hodnoty prázdné
warning("One of the inputs is empty.") # vytisknout varování do konzole
return(NULL) # vrátit prázdný vektor
}
# Komplikovanější kód zde
}
another_complicated_function <- function() {
if (!x) {
return(something_short)
}
# Do
# something
# that
# takes
# many
# lines
# to
# express
}Aby bylo možné puužít funkci v řetězci pipes, je nutné se zamyslet nad výstupními hodnotami (outputs). V tomto kontextu existují dva základní typy funkcí:
- Transformační funkce;
- Funkce s vedlejšími efekty.
Tranformační funkce přijímají jako první argument nějaký datový objekt, nějakým způsobem jej transformují a vrátí modifikovaný objekt. U funkcí s vedlejšími efekty je to tak, že vstupní datový objekt se netransformuje, ale je použit jiným způsobem, např. k tvorbě grafu nebo pro uložení souboru.
Funkce s vedlejšími efekty by měly “skrytě” vrátit svůj první vstupní argument (obvykle nějaký datový objekt). Ten tedy nebude vytištěn do konzole, ale lze jej použít v další pipe. Např. tato funkce vytiskne počet chybějících hodnot do konzole, ale jejím “skutečným” outupem je původní datová matice, ačkoli ta do konzole není vytištěna, protože jsme použili funkci invisible().
sum_of_na <- function(df) {
n <- sum(is.na(df))
cat("Missing values: ", n, "\n", sep = "")
invisible(df)
}Když tuto funkci použijeme, její první input není vytištěn do konzole
sum_of_na(datasets::airquality)># Missing values: 44Jedině kdybychom si to explicitně vyžádali pomocí funkce print()
sum_of_na(datasets::airquality) %>%
print()># Missing values: 44
># Ozone Solar.R Wind Temp Month Day
># 1 41 190 7.4 67 5 1
># 2 36 118 8.0 72 5 2
># 3 12 149 12.6 74 5 3
># 4 18 313 11.5 62 5 4
># 5 NA NA 14.3 56 5 5
># 6 28 NA 14.9 66 5 6
># 7 23 299 8.6 65 5 7
># 8 19 99 13.8 59 5 8
># 9 8 19 20.1 61 5 9
># 10 NA 194 8.6 69 5 10
># 11 7 NA 6.9 74 5 11
># 12 16 256 9.7 69 5 12
># 13 11 290 9.2 66 5 13
># 14 14 274 10.9 68 5 14
># 15 18 65 13.2 58 5 15
># 16 14 334 11.5 64 5 16
># 17 34 307 12.0 66 5 17
># 18 6 78 18.4 57 5 18
># 19 30 322 11.5 68 5 19
># 20 11 44 9.7 62 5 20
># 21 1 8 9.7 59 5 21
># 22 11 320 16.6 73 5 22
># 23 4 25 9.7 61 5 23
># 24 32 92 12.0 61 5 24
># 25 NA 66 16.6 57 5 25
># 26 NA 266 14.9 58 5 26
># 27 NA NA 8.0 57 5 27
># 28 23 13 12.0 67 5 28
># 29 45 252 14.9 81 5 29
># 30 115 223 5.7 79 5 30
># 31 37 279 7.4 76 5 31
># 32 NA 286 8.6 78 6 1
># 33 NA 287 9.7 74 6 2
># 34 NA 242 16.1 67 6 3
># 35 NA 186 9.2 84 6 4
># 36 NA 220 8.6 85 6 5
># 37 NA 264 14.3 79 6 6
># 38 29 127 9.7 82 6 7
># 39 NA 273 6.9 87 6 8
># 40 71 291 13.8 90 6 9
># 41 39 323 11.5 87 6 10
># 42 NA 259 10.9 93 6 11
># 43 NA 250 9.2 92 6 12
># 44 23 148 8.0 82 6 13
># 45 NA 332 13.8 80 6 14
># 46 NA 322 11.5 79 6 15
># 47 21 191 14.9 77 6 16
># 48 37 284 20.7 72 6 17
># 49 20 37 9.2 65 6 18
># 50 12 120 11.5 73 6 19
># 51 13 137 10.3 76 6 20
># 52 NA 150 6.3 77 6 21
># 53 NA 59 1.7 76 6 22
># 54 NA 91 4.6 76 6 23
># 55 NA 250 6.3 76 6 24
># 56 NA 135 8.0 75 6 25
># 57 NA 127 8.0 78 6 26
># 58 NA 47 10.3 73 6 27
># 59 NA 98 11.5 80 6 28
># 60 NA 31 14.9 77 6 29
># 61 NA 138 8.0 83 6 30
># 62 135 269 4.1 84 7 1
># 63 49 248 9.2 85 7 2
># 64 32 236 9.2 81 7 3
># 65 NA 101 10.9 84 7 4
># 66 64 175 4.6 83 7 5
># 67 40 314 10.9 83 7 6
># 68 77 276 5.1 88 7 7
># 69 97 267 6.3 92 7 8
># 70 97 272 5.7 92 7 9
># 71 85 175 7.4 89 7 10
># 72 NA 139 8.6 82 7 11
># 73 10 264 14.3 73 7 12
># 74 27 175 14.9 81 7 13
># 75 NA 291 14.9 91 7 14
># 76 7 48 14.3 80 7 15
># 77 48 260 6.9 81 7 16
># 78 35 274 10.3 82 7 17
># 79 61 285 6.3 84 7 18
># 80 79 187 5.1 87 7 19
># 81 63 220 11.5 85 7 20
># 82 16 7 6.9 74 7 21
># 83 NA 258 9.7 81 7 22
># 84 NA 295 11.5 82 7 23
># 85 80 294 8.6 86 7 24
># 86 108 223 8.0 85 7 25
># 87 20 81 8.6 82 7 26
># 88 52 82 12.0 86 7 27
># 89 82 213 7.4 88 7 28
># 90 50 275 7.4 86 7 29
># 91 64 253 7.4 83 7 30
># 92 59 254 9.2 81 7 31
># 93 39 83 6.9 81 8 1
># 94 9 24 13.8 81 8 2
># 95 16 77 7.4 82 8 3
># 96 78 NA 6.9 86 8 4
># 97 35 NA 7.4 85 8 5
># 98 66 NA 4.6 87 8 6
># 99 122 255 4.0 89 8 7
># 100 89 229 10.3 90 8 8
># 101 110 207 8.0 90 8 9
># 102 NA 222 8.6 92 8 10
># 103 NA 137 11.5 86 8 11
># 104 44 192 11.5 86 8 12
># 105 28 273 11.5 82 8 13
># 106 65 157 9.7 80 8 14
># 107 NA 64 11.5 79 8 15
># 108 22 71 10.3 77 8 16
># 109 59 51 6.3 79 8 17
># 110 23 115 7.4 76 8 18
># 111 31 244 10.9 78 8 19
># 112 44 190 10.3 78 8 20
># 113 21 259 15.5 77 8 21
># 114 9 36 14.3 72 8 22
># 115 NA 255 12.6 75 8 23
># 116 45 212 9.7 79 8 24
># 117 168 238 3.4 81 8 25
># 118 73 215 8.0 86 8 26
># 119 NA 153 5.7 88 8 27
># 120 76 203 9.7 97 8 28
># 121 118 225 2.3 94 8 29
># 122 84 237 6.3 96 8 30
># 123 85 188 6.3 94 8 31
># 124 96 167 6.9 91 9 1
># 125 78 197 5.1 92 9 2
># 126 73 183 2.8 93 9 3
># 127 91 189 4.6 93 9 4
># 128 47 95 7.4 87 9 5
># 129 32 92 15.5 84 9 6
># 130 20 252 10.9 80 9 7
># 131 23 220 10.3 78 9 8
># 132 21 230 10.9 75 9 9
># 133 24 259 9.7 73 9 10
># 134 44 236 14.9 81 9 11
># 135 21 259 15.5 76 9 12
># 136 28 238 6.3 77 9 13
># 137 9 24 10.9 71 9 14
># 138 13 112 11.5 71 9 15
># 139 46 237 6.9 78 9 16
># 140 18 224 13.8 67 9 17
># 141 13 27 10.3 76 9 18
># 142 24 238 10.3 68 9 19
># 143 16 201 8.0 82 9 20
># 144 13 238 12.6 64 9 21
># 145 23 14 9.2 71 9 22
># 146 36 139 10.3 81 9 23
># 147 7 49 10.3 69 9 24
># 148 14 20 16.6 63 9 25
># 149 30 193 6.9 70 9 26
># 150 NA 145 13.2 77 9 27
># 151 14 191 14.3 75 9 28
># 152 18 131 8.0 76 9 29
># 153 20 223 11.5 68 9 30Ale skutečným výstupem funkce je stále původní dataframe, a proto můžeme tuto funkci použít v řetězci pipes
df <- datasets::airquality %>%
set_names(c("ozone", "solar_rad", "wind", "temp", "month", "day"))
df %>%
sum_of_na() %>%
as_tibble() %>%
mutate(
celsius = (temp - 32)/1.8
)># Missing values: 44># # A tibble: 153 × 7
># ozone solar_rad wind temp month day celsius
># <int> <int> <dbl> <int> <int> <int> <dbl>
># 1 41 190 7.4 67 5 1 19.4
># 2 36 118 8 72 5 2 22.2
># 3 12 149 12.6 74 5 3 23.3
># 4 18 313 11.5 62 5 4 16.7
># 5 NA NA 14.3 56 5 5 13.3
># 6 28 NA 14.9 66 5 6 18.9
># 7 23 299 8.6 65 5 7 18.3
># 8 19 99 13.8 59 5 8 15
># 9 8 19 20.1 61 5 9 16.1
># 10 NA 194 8.6 69 5 10 20.6
># # … with 143 more rowsCvičení
- Zkuste vytvořit funkci
not.na(), která bude opakem is.na() - Zkuste vytvořit funkci
mean_if(), která vypočte průměr atomického vektoru pokud počet chybějících hodnot nepřesáhne určitou hodnotu - zkuste vytvořit funkci
sum_na(), která vypočte součet chybějících hodnot - Zkuste vytvořit funkci
reg_linear, která pouze trochu předělá funkcilm()tak, ať prvním argumentem je použitý dataset, nikoli regresní rovnice. - Zkuste vytvořit funkci
item_rangepro tvorbu vektoru s názvem položek, která bude mít tři argumenty:prefix(“předpona”) arange(číselný rozsah) a volitelný argumentwidthpro konstantní počet cifer. Napříkladitem_range("rses", range = 1:3, width = 2)by mělo vytvořit vektorc("rses01", "rses02", "rses03"). Zkuste při tom uplatnit funkcestr_c()astr_pad(), jejichž fungování si můžeme ukázat:
str_c("zacatek", 1:10)># [1] "zacatek1" "zacatek2" "zacatek3" "zacatek4" "zacatek5" "zacatek6"
># [7] "zacatek7" "zacatek8" "zacatek9" "zacatek10"str_pad(1:10, width = 3, pad = "x")># [1] "xx1" "xx2" "xx3" "xx4" "xx5" "xx6" "xx7" "xx8" "xx9" "x10"7 Programování s využitím funkcí balíčku dplyr
Hlavním úskalím programování (psaní vlastních funkcí) s využitím
funcí balíčku dplyr je odkazování se na proměnné, které jsou součástí
datasetů, ale nikoli globálního prostředí. Dejme tomu, že chceme
vytvořit funci var_summary(), která nám spočítá počet
případ a minimální a maximální hodnotu proměnné specifikované argumentem
var z datasetu specifikovaného argumentem data
a využít přitom funkci summarise() z balíčku
dplyr. Mohlo by nás napadnou napsat funkci
takto:
var_summary <- function(data, var) {
data %>%
summarise(n = n(),
Min = min(var),
Max = max(var))
}
df %>%
group_by(month) %>%
var_summary(temp)Ale takto R nechápe, že má proměnnou definovanou v argumente
var hledat v rámci datasetu definovaného pomocí
data, ne v globálním prostředí. Musíme proto
var v rámci těla funkce uzávorkovat do dvojitých složených
závorek.
var_summary <- function(data, var) {
data %>%
summarise(n = n(),
Min = min( {{var}} ),
Max = max( {{var}} )
)
}
df %>%
group_by(month) %>%
var_summary(temp)Takto můžeme do funkce var_summary() jako argument
var specifikovat název sloupce v datech, a to bez uvozovek.
Pokud bychom naopak chtěli, aby do argumentu var bylo možné
zadat název proměnné jako character vektor, použili bychom speciální
funkce .data[[]] takto:
var_summary <- function(data, var) {
data %>%
summarise(n = n(),
Min = min( .data[[var]] ),
Max = max( .data[[var]] )
)
}
df %>%
group_by(month) %>%
var_summary("temp")># # A tibble: 5 × 4
># month n Min Max
># <int> <int> <int> <int>
># 1 5 31 56 81
># 2 6 30 65 93
># 3 7 31 73 92
># 4 8 31 72 97
># 5 9 30 63 93Výsput předešlého kódu je docela OK, ale mohli bychom chtít, aby se
názvy sloupců výstupu měnily podle toho, jakou proměnnou do funkce
var_summary() zvolíme, abychom si byli vždy jisti, jaké
proměnné se výstup týká. Toho můžeme docílit jen mírnou úpravou kódu.
První varianta ukazuje úpravu funkce v případě, že chceme název proměný
vkládat bez uvozovek. Všimněte si, že místo n,
Min a Max jsme uvedli jako názvy vypočtených
statistik "n_{{var}}", "Min_{{var}}"a
"Max_{{var}}", aby se k n, Min a
Max “přilepil” název proměnné uvedené pomocí argumentu
var. Navíc jsme místo v summarise() opeárotru
= použili :=.
var_summary <- function(data, var) {
data %>%
summarise("n_{{var}}" := n(),
"Min_{{var}}" := min( {{var}} ),
"Max_{{var}}" := max( {{var}} )
)
}
df %>%
group_by(month) %>%
var_summary(temp)># # A tibble: 5 × 4
># month n_temp Min_temp Max_temp
># <int> <int> <int> <int>
># 1 5 31 56 81
># 2 6 30 65 93
># 3 7 31 73 92
># 4 8 31 72 97
># 5 9 30 63 93Kdybychom chtěli jména sloupců vkládat jako textový vektor (v
uvozovkách), kód by vypadal takto. Všimněte si, že v názvu statistik
ubyla jedna složená závorka (máme např. "n_{var}" místo
"n_{{var}}"). A na sloupce z datasetu se odkazujeme pomocí
.data[[var]] místo {{var}}.
var_summary <- function(data, var) {
data %>%
summarise("n_{var}" := n(),
"Min_{var}" := min( .data[[var]] ),
"Max_{var}" := max( .data[[var]] )
)
}
df %>%
group_by(month) %>%
var_summary("temp")># # A tibble: 5 × 4
># month n_temp Min_temp Max_temp
># <int> <int> <int> <int>
># 1 5 31 56 81
># 2 6 30 65 93
># 3 7 31 73 92
># 4 8 31 72 97
># 5 9 30 63 93Často také potřebujeme vypočíst statistiky pro více sloupců zároveň,
a k tomu se hodí speciální funkce across(). Dejme tomu, že
chceme vypočíst průměry více proměnných (vars) z dat
(data), plus počet případů. Opět musíme v těle funkce
vars dvojitě uzávorkovat složenými závorkami.
summarise_mean <- function(data, vars) {
data %>%
summarise(n = n(), # Počet případů
across({{ vars }}, mean, na.rm = TRUE) # průměry
)
}
df %>% # Dataset
group_by(month) %>% # Rozdělit do skupin podle měsíce
summarise_mean(c(ozone, temp, wind)) # Vypočíst průměr pro tyto sloupce># # A tibble: 5 × 5
># month n ozone temp wind
># <int> <int> <dbl> <dbl> <dbl>
># 1 5 31 23.6 65.5 11.6
># 2 6 30 29.4 79.1 10.3
># 3 7 31 59.1 83.9 8.94
># 4 8 31 60.0 84.0 8.79
># 5 9 30 31.4 76.9 10.2Pomocí across() tedy můžeme určitou funkci na více
sloupců zároveň. Můžeme se nám ale samozřejmě hodit kód rozšířit o více
funkcí, např. kdybychom chtěli vypočíst jak průměr, tak směrodatnou
ochylku, můžeme definovat funkci summarise_msd() a v ní v
rámci across() definovat list s
funkcemi. Prvky listu je vhodné nějak pojmenovat podle toho, co která
funkce dělá, napříkla M a SD.
summarise_msd <- function(data, vars) {
data %>%
summarise(n = n(), # Počet případů
across({{ vars }},
list(M = function(x) {mean(x, na.rm = TRUE)},
SD = function(x) {sd(x, na.rm = TRUE)}))
)
}
df %>% # Dataset
group_by(month) %>% # Rozdělit do skupin podle měsíce
summarise_msd(c(ozone, temp, wind)) # Vypočíst průměr pro tyto sloupce># # A tibble: 5 × 8
># month n ozone_M ozone_SD temp_M temp_SD wind_M wind_SD
># <int> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
># 1 5 31 23.6 22.2 65.5 6.85 11.6 3.53
># 2 6 30 29.4 18.2 79.1 6.60 10.3 3.77
># 3 7 31 59.1 31.6 83.9 4.32 8.94 3.04
># 4 8 31 60.0 39.7 84.0 6.59 8.79 3.23
># 5 9 30 31.4 24.1 76.9 8.36 10.2 3.46Pokud si chceme ulehčit psaní, můžeme použít zkrácený zápis vnořených funkcí pomocí tildy. Tečka je v nich jako placeholder (pro sloupce, na které bude funkce použita)
summarise_msd <- function(data, vars) {
data %>%
summarise(n = n(), # Počet případů
across({{ vars }},
list(M = ~mean(., na.rm = TRUE),
SD = ~sd(., na.rm = TRUE)))
)
}
df %>% # Dataset
group_by(month) %>% # Rozdělit do skupin podle měsíce
summarise_msd(c(ozone, temp, wind)) # Vypočíst průměr pro tyto sloupce># # A tibble: 5 × 8
># month n ozone_M ozone_SD temp_M temp_SD wind_M wind_SD
># <int> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
># 1 5 31 23.6 22.2 65.5 6.85 11.6 3.53
># 2 6 30 29.4 18.2 79.1 6.60 10.3 3.77
># 3 7 31 59.1 31.6 83.9 4.32 8.94 3.04
># 4 8 31 60.0 39.7 84.0 6.59 8.79 3.23
># 5 9 30 31.4 24.1 76.9 8.36 10.2 3.46Kdybychom chtěli názvy sloupců vkládat jako textový vektor, vnoříme
jej do funkce all_of() takto:
variables <- c("ozone", "temp", "wind")
df %>% # Dataset
group_by(month) %>% # Rozdělit do skupin podle měsíce
summarise_msd(all_of(variables)) # Vypočíst průměr pro tyto sloupce># # A tibble: 5 × 8
># month n ozone_M ozone_SD temp_M temp_SD wind_M wind_SD
># <int> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
># 1 5 31 23.6 22.2 65.5 6.85 11.6 3.53
># 2 6 30 29.4 18.2 79.1 6.60 10.3 3.77
># 3 7 31 59.1 31.6 83.9 4.32 8.94 3.04
># 4 8 31 60.0 39.7 84.0 6.59 8.79 3.23
># 5 9 30 31.4 24.1 76.9 8.36 10.2 3.46Pokud bychom chtěli mít možnost vkládat neomezené množství argumentů
a mít úplnou kontrolu nad některou částí funkce, můžeme použít speciální
argument dot-dot-dot (...). Níže je příklad jednoduché
funkce, která spočítá průměr sloupců mass()a
height() z datasetu starwars a pomocí
... můžeme specifikovat libovolné množství proměnných,
podle kterých se má dataset rozdělit.
glimpse(starwars)># Rows: 87
># Columns: 14
># $ name <chr> "Luke Skywalker", "C-3PO", "R2-D2", "Darth Vader", "Leia Or…
># $ height <int> 172, 167, 96, 202, 150, 178, 165, 97, 183, 182, 188, 180, 2…
># $ mass <dbl> 77.0, 75.0, 32.0, 136.0, 49.0, 120.0, 75.0, 32.0, 84.0, 77.…
># $ hair_color <chr> "blond", NA, NA, "none", "brown", "brown, grey", "brown", N…
># $ skin_color <chr> "fair", "gold", "white, blue", "white", "light", "light", "…
># $ eye_color <chr> "blue", "yellow", "red", "yellow", "brown", "blue", "blue",…
># $ birth_year <dbl> 19.0, 112.0, 33.0, 41.9, 19.0, 52.0, 47.0, NA, 24.0, 57.0, …
># $ sex <chr> "male", "none", "none", "male", "female", "male", "female",…
># $ gender <chr> "masculine", "masculine", "masculine", "masculine", "femini…
># $ homeworld <chr> "Tatooine", "Tatooine", "Naboo", "Tatooine", "Alderaan", "T…
># $ species <chr> "Human", "Droid", "Droid", "Human", "Human", "Human", "Huma…
># $ films <list> <"The Empire Strikes Back", "Revenge of the Sith", "Return…
># $ vehicles <list> <"Snowspeeder", "Imperial Speeder Bike">, <>, <>, <>, "Imp…
># $ starships <list> <"X-wing", "Imperial shuttle">, <>, <>, "TIE Advanced x1",…my_summarise <- function(...) {
starwars %>%
group_by(...) %>%
summarise(mass = mean(mass, na.rm = TRUE),
height = mean(height, na.rm = TRUE))
}
my_summarise(species)># # A tibble: 38 × 3
># species mass height
># <chr> <dbl> <dbl>
># 1 Aleena 15 79
># 2 Besalisk 102 198
># 3 Cerean 82 198
># 4 Clawdite 55 168
># 5 Droid 69.8 131.
># 6 Dug 40 112
># 7 Ewok 20 88
># 8 Geonosian 80 183
># 9 Gungan 74 209.
># 10 Human 82.8 177.
># # … with 28 more rowsmy_summarise(species, sex)># `summarise()` has grouped output by 'species'. You can override using the
># `.groups` argument.># # A tibble: 41 × 4
># # Groups: species [38]
># species sex mass height
># <chr> <chr> <dbl> <dbl>
># 1 Aleena male 15 79
># 2 Besalisk male 102 198
># 3 Cerean male 82 198
># 4 Clawdite female 55 168
># 5 Droid none 69.8 131.
># 6 Dug male 40 112
># 7 Ewok male 20 88
># 8 Geonosian male 80 183
># 9 Gungan male 74 209.
># 10 Human female 56.3 160.
># # … with 31 more rowsmy_summarise(species, sex, gender)># `summarise()` has grouped output by 'species', 'sex'. You can override using
># the `.groups` argument.># # A tibble: 42 × 5
># # Groups: species, sex [41]
># species sex gender mass height
># <chr> <chr> <chr> <dbl> <dbl>
># 1 Aleena male masculine 15 79
># 2 Besalisk male masculine 102 198
># 3 Cerean male masculine 82 198
># 4 Clawdite female feminine 55 168
># 5 Droid none feminine NaN 96
># 6 Droid none masculine 69.8 140
># 7 Dug male masculine 40 112
># 8 Ewok male masculine 20 88
># 9 Geonosian male masculine 80 183
># 10 Gungan male masculine 74 209.
># # … with 32 more rowsMísto ... bychom mohli opět použít across, ale pak
bychom museli nejdříve sloučit názvy sloupců do jednoho vektoru pomocí
c()
my_summarise <- function(group) {
starwars %>%
group_by(across( {{group}} )) %>%
summarise(mass = mean(mass, na.rm = TRUE),
height = mean(height, na.rm = TRUE))
}
my_summarise(species, sex, gender) # Toto by nefungovalo># Error in my_summarise(species, sex, gender): unused arguments (sex, gender)my_summarise(c(species, sex, gender)) # Toto ano># `summarise()` has grouped output by 'species', 'sex'. You can override using
># the `.groups` argument.># # A tibble: 42 × 5
># # Groups: species, sex [41]
># species sex gender mass height
># <chr> <chr> <chr> <dbl> <dbl>
># 1 Aleena male masculine 15 79
># 2 Besalisk male masculine 102 198
># 3 Cerean male masculine 82 198
># 4 Clawdite female feminine 55 168
># 5 Droid none feminine NaN 96
># 6 Droid none masculine 69.8 140
># 7 Dug male masculine 40 112
># 8 Ewok male masculine 20 88
># 9 Geonosian male masculine 80 183
># 10 Gungan male masculine 74 209.
># # … with 32 more rowsFunkce můžeme rozšiřovat o libovolné množství argumentů, například
argumentem group_var nejdříve specifikovat rozdělení
datasetu do skupin a argumentem summarise_var specifikovat
proměnné, pro které se má vypčíst nějaká statistika
my_summarise <- function(data, group_var, summarise_var) {
data %>%
group_by(across({{ group_var }})) %>%
summarise(across({{ summarise_var }}, mean, na.rm = TRUE))
}
my_summarise(starwars,
group_var = species,
summarise_var = c(mass, height))># # A tibble: 38 × 3
># species mass height
># <chr> <dbl> <dbl>
># 1 Aleena 15 79
># 2 Besalisk 102 198
># 3 Cerean 82 198
># 4 Clawdite 55 168
># 5 Droid 69.8 131.
># 6 Dug 40 112
># 7 Ewok 20 88
># 8 Geonosian 80 183
># 9 Gungan 74 209.
># 10 Human 82.8 177.
># # … with 28 more rowsJména sloupců v outputu můžeme upravit argumentem .names
následovně. Všimněte si, že {.col} je placeholder pro název
slöupců ve summarise_var.
my_summarise <- function(data, group_var, summarise_var) {
data %>%
group_by(across({{ group_var }})) %>%
summarise(across({{ summarise_var }}, mean, na.rm = TRUE,
.names = "mean_{.col}"))
}
my_summarise(starwars,
group_var = species,
summarise_var = c(mass, height))># # A tibble: 38 × 3
># species mean_mass mean_height
># <chr> <dbl> <dbl>
># 1 Aleena 15 79
># 2 Besalisk 102 198
># 3 Cerean 82 198
># 4 Clawdite 55 168
># 5 Droid 69.8 131.
># 6 Dug 40 112
># 7 Ewok 20 88
># 8 Geonosian 80 183
># 9 Gungan 74 209.
># 10 Human 82.8 177.
># # … with 28 more rowsOpět bychom také mohli vytvořit list s více funkcemi pro výpočet většího množtsví statistik než jen průměru.
my_summarise <- function(data, group_var, summarise_var) {
data %>%
group_by(across({{ group_var }})) %>%
summarise(
across({{ summarise_var }},
list(M = ~mean(., na.rm = TRUE),
SD = ~sd(., na.rm = TRUE)))
)
}
my_summarise(starwars,
group_var = species,
summarise_var = c(mass, height))># # A tibble: 38 × 5
># species mass_M mass_SD height_M height_SD
># <chr> <dbl> <dbl> <dbl> <dbl>
># 1 Aleena 15 NA 79 NA
># 2 Besalisk 102 NA 198 NA
># 3 Cerean 82 NA 198 NA
># 4 Clawdite 55 NA 168 NA
># 5 Droid 69.8 51.0 131. 49.1
># 6 Dug 40 NA 112 NA
># 7 Ewok 20 NA 88 NA
># 8 Geonosian 80 NA 183 NA
># 9 Gungan 74 11.3 209. 14.2
># 10 Human 82.8 19.4 177. 12.5
># # … with 28 more rowsCustomizovat danou funkci by bylo možné dále, například opět upravit
názvy sloupců ve výstupu pomocí .names, aby nejprve byl
název funkce a až poté název proměnné. Všimněte si, že
{.fn} je placeholder pro název funkce (což jsou v tomto
případě názvy prvků listu z funkcemi: M a SD)
a {.col} je placeholder pro název sloupce.
my_summarise <- function(data, group_var, summarise_var) {
data %>%
group_by(across({{ group_var }})) %>%
summarise(
across({{ summarise_var }},
list(M = ~mean(., na.rm = TRUE),
SD = ~sd(., na.rm = TRUE)),
.names = "{.fn}_{.col}")
)
}
my_summarise(starwars,
group_var = species,
summarise_var = c(mass, height))># # A tibble: 38 × 5
># species M_mass SD_mass M_height SD_height
># <chr> <dbl> <dbl> <dbl> <dbl>
># 1 Aleena 15 NA 79 NA
># 2 Besalisk 102 NA 198 NA
># 3 Cerean 82 NA 198 NA
># 4 Clawdite 55 NA 168 NA
># 5 Droid 69.8 51.0 131. 49.1
># 6 Dug 40 NA 112 NA
># 7 Ewok 20 NA 88 NA
># 8 Geonosian 80 NA 183 NA
># 9 Gungan 74 11.3 209. 14.2
># 10 Human 82.8 19.4 177. 12.5
># # … with 28 more rows# Kdybychom chtěli názvy proměnných vkládat jako textové vektory
my_summarise(starwars,
group_var = all_of("species"),
summarise_var = all_of(c("mass", "height")))># # A tibble: 38 × 5
># species M_mass SD_mass M_height SD_height
># <chr> <dbl> <dbl> <dbl> <dbl>
># 1 Aleena 15 NA 79 NA
># 2 Besalisk 102 NA 198 NA
># 3 Cerean 82 NA 198 NA
># 4 Clawdite 55 NA 168 NA
># 5 Droid 69.8 51.0 131. 49.1
># 6 Dug 40 NA 112 NA
># 7 Ewok 20 NA 88 NA
># 8 Geonosian 80 NA 183 NA
># 9 Gungan 74 11.3 209. 14.2
># 10 Human 82.8 19.4 177. 12.5
># # … with 28 more rows7.1 Programování v ggplot2
I když jsme se zatím věnovali hlavně funkcím
dplyr, programování např. s
ggplot2 má podobnou logiku, protože oba
balíčky patří pod tidyverse. Takhle bychom
například mohli vyvořit jednoduchou funkci pro tvorbu scatterplotu.
Všimněte si, že názvy proměnných {{x}} a {{y}}
opět dáváme do dvojitých složených závorek, pokud je chceme zadávat bez
uvozovek.
plot_scatter <- function(data, x, y) {
data %>%
ggplot(aes( {{x}}, {{y}} )) +
geom_point()
}
plot_scatter(df, x = temp, y = solar_rad)
Kdybychom je chtěli zadávat s uvozovkami jako textový vektor, použijeme
aes_string() místo místo aes() :
plot_scatter <- function(data, x, y) {
data %>%
ggplot(aes_string( {{x}}, {{y}} )) +
geom_point()
}
plot_scatter(df, x = "temp", y = "solar_rad")
Anebo speciální funkci .data[[ ]], kterou už známe z
nětkerých předchozích příkladů.
plot_scatter <- function(data, x, y) {
data %>%
ggplot(aes( .data[[x]], .data[[y]] )) +
geom_point()
}
plot_scatter(df, x = "temp", y = "solar_rad")
#### Cvičení Zkuste předchozí funkci rozšířit tak, ať kromě průměru a SD
počítá také jiné deskriptivní statistiky, např. medián a mezikvartilové
rozpětí a počet validních hodnot. Můžete uplatnit funkce
median(), IQR() a také !is.na() a
sum(). Zmeňte také funkci tak, ať je na.rm
měnitelný vstupní argument (tj. ať není v každé statistické funkci
napevno na.rm = TRUE).
Zkuste funkci plot_scatter() rozšířit o další argumenty,
např. barvu či velikost bodů. Zkuste vytvořit jednoduché grafické funkce
podobné plot_scatter(), ale pro jiné typy grafů, např.
boxplot nebo histogram.
7.2 Kontextuální funkce
dplyr nabízí rovněž několik tzv.
kontextuálních funkcí, což jsou funkce, jejichž výstup závisí na
“kontextu”: roztřídění datasetu do skupin pomocí group_by()
Jsou to mj. tyto funkce:
n()vráti velikost (počet řádků) v dané skupině.cur_data()vrátí veškerá data pro danout skupinu s výjimkou grouping variables (tj. s výjimkou sloupců, podle kterých je dataset rozdělen)cur_data_all()vrátí veškerá data pro danout skupinu včetně grouping variables.
Nejprve si vytvoříme cvičný dataset.
set.seed(3)
df <- tibble(
g = sample(c(1,2,3), size = 10, replace = TRUE),
a = rnorm(10),
b = rnorm(10),
c = rnorm(10)
)
df># # A tibble: 10 × 4
># g a b c
># <dbl> <dbl> <dbl> <dbl>
># 1 1 -0.584 -0.815 -0.584
># 2 2 -2.16 0.794 -1.58
># 3 3 -1.32 0.178 -1.26
># 4 2 0.810 -0.620 -0.511
># 5 3 1.34 -1.26 0.102
># 6 3 0.693 0.844 -1.33
># 7 2 -0.323 -0.796 0.709
># 8 3 -0.117 2.47 1.83
># 9 1 -0.423 1.34 0.124
># 10 2 -0.835 -0.757 -0.976Funci n() už známe a můžeme ji využít v rámci summarise,
abychom měli přehled o velkosti skupin.
df %>%
group_by(g) %>%
summarise(n = n(),
M = mean(a))># # A tibble: 3 × 3
># g n M
># <dbl> <int> <dbl>
># 1 1 2 -0.503
># 2 2 4 -0.627
># 3 3 4 0.149Funkce cur_data() a cur_data_all() můžeme
použít, pokud bychom chtěli z jednoho tibblu vytvořit list s několika
tibbles pro každou skupinu:
df %>%
group_by(g) %>%
summarise(list_of_tibbles = list(cur_data()))># # A tibble: 3 × 2
># g list_of_tibbles
># <dbl> <list>
># 1 1 <tibble [2 × 3]>
># 2 2 <tibble [4 × 3]>
># 3 3 <tibble [4 × 3]>Obě funkce však můžeme využít také při vytváření vlastních funkcí.
Dejme tomu, že chci vytvořit funkci k výpočtu součtového sköru pro
vybrané sloupce, kterou bude možné použít v rámci funkcí
dplyr, včetně mutate(). Úplně
základní podoba této fukce a příklad jejího použítí mohou vypadat
takto
row_sum <- function(cols) {
cur_data() %>%
select( {{cols}}) %>%
rowSums()
}
df %>%
mutate(
sum_abc = row_sum(c(a, b, c))
)># # A tibble: 10 × 5
># g a b c sum_abc
># <dbl> <dbl> <dbl> <dbl> <dbl>
># 1 1 -0.584 -0.815 -0.584 -1.98
># 2 2 -2.16 0.794 -1.58 -2.94
># 3 3 -1.32 0.178 -1.26 -2.40
># 4 2 0.810 -0.620 -0.511 -0.320
># 5 3 1.34 -1.26 0.102 0.182
># 6 3 0.693 0.844 -1.33 0.211
># 7 2 -0.323 -0.796 0.709 -0.410
># 8 3 -0.117 2.47 1.83 4.18
># 9 1 -0.423 1.34 0.124 1.05
># 10 2 -0.835 -0.757 -0.976 -2.57Cvičení
Zkuste vytvořit funkci row_na(), která vypočte součet
chybějících hodnot na jednotlivém řádku pro zvolené sloupce.
Můžete vlastně jen vhodným způsobem upravit funkci
row_sum(). Jedniným argumentem budou vybrané sloupce.
Zkuste vytvořit funkci row_mean(), která místo sumy
vypočte průměr z určených sloupců pro každý řádek. Můžeme k tomu využít
opět funkce cur_data() a select(), ale namísto
rowSums() použijte rowMeans(). Jediným
argumentem budou vybrané sloupce.
Zkuste do funkce row_mean() přidat další argument
max.na s defaultní hodnotou 0 a funkci upravit tak, aby se
průměr vypočetl pro daný řádek jen tehdy, pokud je počet chybějících
hodnot ve vybraných sloupcích menší nebo rovno právě hodnotě argumentu
max.na (jinak by funkce měla vrátit NA).
Jako poslední úpravu se pokuste funkci row_mean()
rozšířit tak, aby kontrolovala, že všechny vybrané slupce jsou
numerickými vektory, a pokud toho není dodržena, aby vrátila chybovou
hlášku, např. “All selected columns must be numeric.”