library(tidyverse)

# Kdy vytvořit vlastní funkci funkci? ------------------------------
# Funkce jsou prvník krokem k tomu vyhnout se zbytečnému copy-pastování. 

# Nejprve si vytvoříme cvičný dataframe s proměnnými.

df <- tibble(
  a = rnorm(10),
  b = rnorm(10),
  c = rnorm(10),
  d = rnorm(10),
  e = rnorm(10)
)

df

# A 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

# 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))

# Tento 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))

# Duplikaci kódu můžeme dále omezit použitím range()
range(x)
rng <- range(x, na.rm = TRUE)

(x - rng[1]) / (rng[2] - rng[1])


# Když 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))

# Tvorba funkce zahrnuje tři základní kroky:
# 1. Musíme vybrat příhodné jméno, podle toho, k čemu daná funkce slouží
# 2. Pak musíme vypsat názvy jejích argumentů čili vstupních hodnot (inputs) 
#    v rámci function()
# 3. 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))
rescale_01(c(1, 2, 3, NA, 5))

# Další výhodou funkcí je to, že když narazíme na něco, s čím jsme nepočítali, 
# stačí obvykle změnit jed danou funkci

x <- c(1:10, NA, Inf)
rescale_01(x)

rescale_01 <- function(x, finite = TRUE) {
  rng <- range(x, finite = finite)  
  (x - rng[1]) / (rng[2] - rng[1])
}

rescale_01(x)
rescale_01(x, finite = FALSE)

# CVIČENÍ
# Zkuste 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))

# Kód 2
x <- 1:10
x / sum(x, na.rm = TRUE)

# Vytvoř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 &
x <- c(1, NA, 3, 4, NA)
y <- c(1, NA, 5, 6, 7)

# 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)

# Podmí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. 

if (c(TRUE, FALSE)) {}
if (NA) {}

# Abychom získali vždy jen jedno TRUE či FALSE,
# můžeme použít funkci any() anebo all()
x <- c(-10, 0, 3, 5)
x < 0
any(x < 0) # platí podmínka aspoň pro jeden prvek?
all(x < 0) # platí podmínka pro všechny prvky?

# Více podmínek lze zkombinovat následujícím způsobem
if (podminka_1) {
  # udělej něco, pokud je splněna podminka_1
} else if (podminka_2) {
  # udělej něco jiného, pokud není splněna podminka_1, ale podminka_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()
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")
basic_math(6, 7, operation = "minus")
basic_math(6, 7, operation = "square")

# 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"))
# Můžete také využít funkce between() pro snadnější specifikaci podmínek.

# Argumenty funkcí -------------------------------------------------------
# V zásadě existují dva obecné typy argumentů. 
# 1. Datové argumenty (tj. různé typy vektorů), které chceme nějak transformovat 
#    čili z nich něco vytvořit, vypočíst. 
# 2. Specifikační argumenty, které upravují způsob výpočtu,
#    transformace – prostě podrobněji upravují chování funkce

# 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 level je specifikační argument, 
# který má defaultní hodnotu 0.95
ci_mean <- function(x, level = 0.95) {
  se <- sd(x) / sqrt(length(x))
  alpha <- 1 - level
  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
ci_mean(x, level = 0.68)
ci_mean(level = 0.99) # ale argumenty, které nemají default, specifikovat musíme

# 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ě
x <- c(1:10, NA)
mean(x, na.rm = TRUE)

# Takhle je to špatně
mean(x, , TRUE)
mean( , TRUE, x = x)

# R používá mapování argumentů podle jména a pozice. Např. funkce mean má tři argumenty:
mean(x = x, trim = 0, na.rm = TRUE)

# Kdybychom měli kód:
mean(, TRUE, x = x)
# 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.

# ** Kontrola vstupních hodnot ----------------------------
# Je snadné se dopustit toho, že do funkce omylem zadáme neplatné 
# vstupní hodnoty. Máme např. skupinu funkcí pro výpočet váženého průměru: 
wt_mean <- function(x, w) {
  sum(x * w) / sum(w)
}

# Co se stane, když vektor dat x a vah w nemají stejnou délku
wt_mean(1:6, 1:3)
# Protože R recykluje vektory, nemusíme zjistit, že jsme udělali chybu.
# 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:

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)
wt_mean(c("a", "b", "c"), 1:3)


# ** Dot-dot-dot (…) ----------------------------
# Mnoho funkcí v R přijímá neomezený počet argumentů/vstupních hodnot
# Jak tyto funkce fungují? Využívají speciální argument ... (čteno dot-dot-dot)

# 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 = ", ")
}
letters
commas(letters)

# Výstupní hodnoty (Output) --------------------------------------
# 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 (%>%)

# 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) {
  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 následoval zde
}

# Aby bylo možné puužít funkci v řetězci pipes, je nutné se zamyslet 
# nad výstupními hodnotami (outputem). 

# V tomto kontextu existují dva základní typy funkcí:
# 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).

# Tato funkce vypočte počet chybějících hodnot a skrytě vrátí původní dataset
sum_of_na <- function(df) {
  n <- sum(is.na(df))
  cat("Missing values: ", n, "\n", sep = "")
  
  invisible(df)
}

sum_of_na(datasets::airquality)

sum_of_na(datasets::airquality) %>% 
  head()

datasets::airquality %>% 
  sum_of_na() %>% 
  as_tibble() %>% 
  mutate(
    celsius = (Temp - 32)/1.8
  )

# Programování s využitím balíčku dplyr ---------------------------------
# Psaní funkcí využívajících funkce s balíčku dplyr je komplikovanější
# protože využívají buďto tvz. DATA MASKING (díky tomu se můžeme odkazovat
# na proměnné z datasetu tak jako by se jednalo o proměnné v globálním 
# prostředí), nebo tzv. TIDY SELECTION (díky tomu se můžeme na proměnné
# odkazovat pomocí jejich pozice, jména nebo typu)

# To nám usnadňuje práci s daty, ale komplikuje vytváření nových funkcí 
# využívajících funkce balíčku dplyr

# Programování s využitím funkcí balíčku dplyr by zabralo celou další lekci,
# ale pokud vás to zajímá, podívejte se na:
# https://dplyr.tidyverse.org/articles/programming.html


# Cvič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á funkci lm() 
# tak, ať prvním argumentem je použitý dataset, nikoli regresní rovnice.


# Zkuste vytvořit funkci item_range pro tvorbu vektoru s názvem položek,
# která bude mít tři argumenty: prefix (“předpona”) a range (číselný rozsah) 
# a volitelný argument width pro konstantní počet cifer. 
# Například item_range("rses", range = 1:3, width = 2) 
# by mělo vytvořit vektor c("rses01", "rses02", "rses03"). 
# Zkuste při tom uplatnit funkce str_c() a str_pad(), 
# jejichž fungování si můžeme ukázat:
str_c("prefix", 1:10)
str_pad(1:10, width = 3, pad = "0")