##%######################################################%##
#                                                          #
####                 Writing functions                  ####
#                                                          #
##%######################################################%##

library(tidyverse)
set.seed(123)

# Funkce jsou prvník krokem k tomu vyhdnout se zbytečnému copy-pastování

# Kdy vytvořit funkci ----------------------------------------
cor
# Nejlépe kdykoli, když nějaký kód kopírujeme více než dvakrát

# Cvičný dataframe
df <- tibble(
  a = rnorm(10),
  b = rnorm(10),
  c = rnorm(10),
  d = rnorm(10),
  e = rnorm(10)
)

df

# Zkuste říct, 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 zjistit,
# 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$a
# 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() namísto min() a max()
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 funkci

rescale01 <- function(x) {
  rng <- range(x, na.rm = TRUE)
  (x - rng[1]) / (rng[2] - rng[1])
}

rescale01(c(0, 5, 10))

# Tvorba funkce zahrnuje tři kroky:
# JMÉNO, VSTUPNÍ HODNOTY/ARGUMENTY (INPUTS) A TĚLO FUNKCE (BODY)
  # 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 {...}


# Když funkci vytvoříme, měli bychom ji vyzkoušet s různými vstupními
# hodnotami, jestli funguje tak, jak má

rescale01(c(-10, 0, 10))
rescale01(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čí učinit jen malou změnu dané funkce.

# Např. když zjistíme, že některé proměnné zahrnují nekonečno a funkce
# rescale01 nepracuje tak, jak potřebujeme
x <- c(1:10, NA, Inf)
rescale01(x)

# Protože k tranformaci dat jsme použili funkci, stačí změnit jen její chování
# např. doplnit finite = TRUE, aby funkce ponechala -Inf a +Inf (ale i NA) beze
# změny a nezahrnovala je do výpočtu rng
rescale01 <- function(x) {
  rng <- range(x, finite = TRUE) # 
  (x - rng[1]) / (rng[2] - rng[1])
}

rescale01(x)

### Exercises
# Why is TRUE not a parameter to rescale01()? 
# What would happen if x contained a single missing value, and na.rm was FALSE?
rescale01 <- 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)
rescale01(x, na.rm = FALSE)


# Nebo můžeme -Inf tranformovat na nulu a +Inf na jedničku
rescale01 <- function(x) {
  rng <- range(x, finite = TRUE)
  y <- (x - rng[1]) / (rng[2] - rng[1])
  y[y == -Inf] <- 0
  y[y == Inf] <- 1
  y
}


# * Cvičení -----------------------------------------------------------------

# Zkuste z tohoto kódu vytvořit funkce s výstižným názvem
mean(is.na(x))

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 z nich 
# mají chybějící hodnotu (NA)

# Najděte si rovnici pro výpočet rozptylu a zkuste napsat vlastní funkci 
# variance() pro výpočet rozptylu


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

# Příliš krátké
f()

# Nevýstižné, navíc to není sloveso
my_awesome_function()

# Delší, ale výstižné
impute_missing()
collapse_years()

# Pokud se název funkce skládá z více slov, doporučuji 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ů

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

# Tak takhle 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
f1 <- function(string, prefix) {
  substr(string, 1, nchar(prefix)) == prefix
}

f1(c("abc", "abcde", "ad", "ba"), "ab")

f2 <- function(x) {
  if (length(x) <= 1) return(NULL)
  x[-length(x)]
}

f2(1:7)
f2(1:6)
f2(1:5)

f3 <- function(x, y) {
  rep(y, length.out = length(x))
}

f3(1:10, 1:3)


# 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í (TRUE)
} else {
  # kód spuštěný, když podmínka neplatí (FASE)
}

# Toto je 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

has_name <- function(x) {
  nms <- names(x) # Extrahovat jména prvků vektoru
  if (is.null(nms)) { # Podmína: nms je prázdný vektor, což bude, pokud prvky x nemají žádná jména
    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 ""
  }
}


# 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.
# Pokud je délka větší než 1, dostaneme varování
# NA ústní chybu
if (c(TRUE, FALSE)) {}
if (NA) {}

# Ve výrazech if else bychom měli používat jako logické operátory || (nebo)
# či && (a zároveň) namísto | a %, protože vedou k rychlejšímu vyhodnocení
# podmínek. || vrátí TRUE, jakmile vidí první TRUE (pak už nemá 
# smysl pátrat po tom, zda jsou ostatní TRUE nebo FALSE, protože výsledek bude
# vždy TRUE); a && vrátí FALSE, jakmile uvidí první FALSE.

# Abychom získali vždy jen jedno TRUE/FALSE, můžeme použít funkce any() nebo
# all()
x <- c(-10, 0, 3, 5)
x < 0
any(x < 0) # Vráří TRUE, když je aspoň jeden prvek < 0, jinak FALSE
all(x < 0) # Vráří TRUE, když je všechny prvky < 0, jinak FALSE

# * Více podmínek ------------------------------------------------------------

# Více podmínek lze zkombinovat následujícím způsobem
if (first_conditon) {
  # udělej něco, pokud je splněna first_conditon
} else if (that) {
  # udělej něco jiného
} else {
  # 
}

# Ale když se řetězec podmínek začne hodně rozrůstat, je lepší použít 
# funkci switch() jako alternativu if else

# But if you end up with a very long series of chained if statements, 
# you should consider rewriting. One useful technique is the switch() function.
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 = "times")

# * Cvičení ----------------------------------------
# Vytvořte funkci greeting(), 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í hodiny můžete použít 
as.integer(format(Sys.time(), format = "%H"))

# a ke stanovení logických podmínek funkci between()


# 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ě detailně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 počítající interval spohlehlivosti pro průměr
# x je datový argument, který pochopitelně nemá žádnou defaultní hodnotu
# 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
ci_mean(x, conf = 0.68)
ci_mean(x, conf = 0.99)
ci_mean(conf = 0.99) # ale argumenty, které nemají default, specifikovat musíme

# Defaultní hodnota by měla být nejpoužívanější hodnotou. 
# Ale ne vždy pokud nám jde o bezpečnost. Např. defaultní hodnota
# argumentu na.rm je 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
# 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)

# Takhle je to špatně
mean(x = 1:10, , FALSE)
mean(, TRUE, x = c(1:10, NA))
# R používá mapování argumentů podle jména a pozice
# Např. funkce mean má tři argumenty:
  # mean(x, trim = 0, na.rm = FALSE, ...)
mean(, TRUE, x = c(1:10, NA))
# 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 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 a váh nemají stejnou délku
wt_mean(1:6, 1:3)

# Protož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))
  sum(w * x) / sum(w)
}
wt_mean(1:6, 1:3)

# * 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)
stringr::str_c("a", "b", "c", "d", "e", "f")

# 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
commas <- function(...) {
  paste0(..., collapse = ", ")
  }
commas(letters)
commas("a", "b", "c", c(1, 2, 3))


# * Cvičení ---------------------------------- 
# Proč toto nefunguje?
commas(letters, collapse = "-")

# a je nutné funkci upravit takto?
commas <- function(..., collapse = ", ") stringr::str_c(..., collapse = collapse)
commas(letters, collapse = "-")

# 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)
basic_math(3, 6, "times")
basic_math(3, 6, "power")

# 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:
  # 1. tzv. brzký výstup, aby byla funkce lépe čitelná.
  # 2. možnost použít funkci v řetězci pipes (%>%)

# Výstu funkce je obvykle závisí na posledním ještě spuštěném řádku kódu
# Jinak můžete také explicitně použít funkci return()
# zejména v případě, že je možné použít jednodušší kód.

# Příklady

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
}


f <- 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.

# V tomto kontextu existují dva základní typy funkcí
# Transformační funkce a 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 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)

# Jedině kdybychom si to explicitně vyžádali pomocí funkce print()
sum_of_na(datasets::airquality) %>% 
  print()

# Ale výstupem funkce je stále původní dataframe, a proto můžeme tuto funkci
# použít v řetězci pipes
datasets::airquality %>% 
  sum_of_na() %>% 
  as_tibble() %>% 
  mutate(
    Celsius = (Temp - 32)/1.8
  )











