##%######################################################%##
#                                                          #
####                      Iterace                       ####
#                                                          #
##%######################################################%##
library(tidyverse)

# jedním ze způsobů, jak redukovat duplicitní kód, jsou funkce.
# Dalším je iterace čili opakovaní stejné operace na různé vektory


# For loops ---------------------------------------------------------------
# Dejme tomu, že mámu tento jednoduchý dataframe
df <- tibble(
  a = rnorm(10),
  b = rnorm(10),
  c = rnorm(10),
  d = rnorm(10)
)
df

# Kdybyste chtěli spočítat medián každého sloupce, můžeme copy-pastovat kód
median(df$a)
median(df$b)
median(df$c)
median(df$d)

# To ale není moc efektivní a navíc to zvyšuje pravděpodobnost, že někde
# uděláte chybu
# Kromě toho bychom nikdy neměli copy-pastovat více než dvakrát


# Místo toho můžeme použít for loop

# Nejdříve si připravíme výstupní vektor
output <- double(length(df))  # 1. output
output # Prázdný vektor typu double, který má tolik prvků, kolik bude mediánů

for (i in seq_along(df)) {            # 2. sekvence
  output[[i]] <- median(df[[i]])      # 3. tělo for loopu
}

output

# for (i in seq_along(df)) vyvolává jednotlivé prvky z seq_along(df)
# seq_along(df) vyjede vektro s čísly prvků (sloupců)
seq_along(df)

# For loop vlastně vyvolává jednotlivé prvky i z seq_along(df)
for (i in seq_along(df)) {            
  print(i)    
}

# Každá for loop má tři části
# 1. OUTPUT: output <- double(length(x))
# Musíme si připravit prázdný výstupní vektor, který má náležitý počet prvků
# a správný typ.Protože počítáme 4 mediány a máme spojité proměnné,
# Připravíme si vektor typu double o délce 4

# 2. SEKVENCE: i in seq_along(df). Ta určuje průběh for loop.
# Každá iterace for loop přiřadí objektu i jednu (a pouze jednu) 
# z hodnot seq_along(df), 
# První iterace první hodnotu z seq_along(df), druhá druhou atd.

# 3: TĚLO  output[[i]] <- median(df[[i]]). Hlavní kód. který dělá to, co chceme. 
# Je spouštěn opakovaně, pokaždé s jinou hodnotou i.
# První iterace tedy vypadá takto output[[1]] <- median(df[[1]]),
# druhá takto  output[[2]] <- median(df[[2]]), atd. dále.


### Cvičení
# Zkuste napsat for loop, 
# která vypočte průměr každého sloupce z datasetu mtcars
out <- double(length = ___) %>% 
  set_names(nm = ___)

for (i in ___) {
  out[[i]] <- ___
}

out

# která určtí typ, typeof(), každého sloupce z datasetu starwars
out <- double(length = ___) %>% 
  set_names(nm = ___)

for (i in ____) {
  out[[i]] <- typeof(___)
}

out

# která vypočte počet jedinečných hodnot z každé sloupce datasetu iris
out <- out <- integer(length = ___) %>% 
  set_names(nm = ___)

for (i in ____ ) {
  ____ <- n_distinct(___)
}

out

# Generuje 10 náhodných čísel z normání distribuce
# s průměry -10, 0, 10, and 100.
mu <- c(-10, 0, 10, 100)
out <- vector("list", length = length(mu))

for (i in seq_along(mu)) {
  out[[i]] <- rnorm(n = ___, mean = ___)
}
out

# Varianty for loops -------------------------------------------------
# Existují čtyři variace na základní for loops

# Modifikace stávajícího objektu, namísto tvorby nového
# Loopování napříč jmény nebo hodnotami vektoru, namísto číselných indexů
# Práce s výstupy neznámé délky.
# Práce se sekvencemi neznémé délky

# * Iterace modifikující stávající objekt ---------------------------

# Dejme tomu, že máme tento dataframe
df <- tibble(
  a = rnorm(10),
  b = rnorm(10),
  c = rnorm(10),
  d = rnorm(10)
)

# A chceme každý sloupce tranformovat na hodnoty s minimem = 0 a maximem = 1
# Vytvoříme si k tomu příslušnou funkci
rescale01 <- function(x) {
  rng <- range(x, na.rm = TRUE)
  (x - rng[1]) / (rng[2] - rng[1])
}

# Můžeme kód copy-pastovat, ale to bychom to dělat neměli
# df$a <- rescale01(df$a)
# df$b <- rescale01(df$b)
# df$c <- rescale01(df$c)
# df$d <- rescale01(df$d)

# Proto si vytvoříme for loop
# Outputem bude zároveň náš Input

# A protože dataframe je vlastně vektor typu list s prvky stejné délky,
# můžeme iterační sekvenci vyvořit pomocí seq_along(df)

# V tělo for loop pak použijeme funkci rescale.

for (i in seq_along(df)) {
  df[[i]] <- rescale01(df[[i]])
}

# * Iterace napříč prvky samotnými ---------------------------------
# For loop pro samotné prvky z x: for(x in xs)
# Vovolává samotné prvky x z xs
# Hodí se hlavně tehdy, když nechceme output ukládat,
# např. při tvorbě více grafů zároveň
  
for (x in mtcars) {
  hist(x)
}

# * Iterace pomocí názvů prvků -------------------------------------
# for (nm in names(x))
# Vyvolává jednotlivá jména prvků
# Takže dostaneme postupně jednotlivé názvy prvků, které můžeme využit
# k subsettingu, např. x[[nm]]
# Jména prvků pak můžeme vyuít k pojmenování výsledků, grafů nebo vytvořených
# souborů
#

out <- double(length = length(mtcars)) %>% 
  set_names(colnames(mtcars))
out

for (nm in colnames(mtcars)) {
  out[[nm]] <- mean(mtcars[[nm]])
}
out

# * Iterace pomocí číselných indexů ----------------------------------
# Iterace pomocí číselných indexů je základní formou iterace,
# protože na základě číselné pozice lze vyvolat jak názvy, tak hodnoty:

out <- double(length = length(mtcars))
out

for (i in seq_along(mtcars)) {
  names(out)[[i]] <- colnames(mtcars)[[i]]
  out[[i]] <- mean(mtcars[[i]])
}

out

# * Iterace s neznámou délkou outputu --------------------------

# Někdy neznéme délku outputu.
# Např, kdybychom chtěli simulovat vekrory náhodné délky.
# Řešením je uložit si výsledky do listu, protože ten může obsahovat prvky
# rozdílné délky, a pak případně prvky listu sloučit do jednoho atomického
# vektoru

means <- c(0, 1, 2)
out <- vector("list", length(means))

for (i in seq_along(means)) {
  n <- sample(100, 1) 
  out[[i]] <- rnorm(n, means[[i]])
}
str(out)
unlist(out) %>% head()

# * Iterace s neznámou délkou sekvence --------------------------

# Někdy neznáme ani délku vstupní sekvence hodnot, např. když děláme nějaké
# simulace. Přestavme si například, že chceme simulovat hody mincí a iterování
# ukončit, až když padne hlava třirkát za sebou.
# To nelze udělat pomocí for loop, ale pomocí while loop ano.


# A while loop vyžaduje stanovení podmínky, po jejíž naplnění se iterace ukončí
  # while (condition) {
  #   body
  # }

out <- double(ncol(mtcars))
out

i <- 1

while (i <= ncol(mtcars)) {
  out[[i]] <- mean(mtcars[[i]])
  names(out)[[i]] <- colnames(mtcars)[[i]]
  i <- i + 1 
}

out


# Takhle bychom mohli pomocí while loop simulovat hody mincí a zjistit,
# kolik hodů je nutných, aby padla třikrát za sebou hlava
flip <- function() sample(c("H", "T"), 1)
flip() # funkce náhodně vybírá "H" nebo "T"

flips <- 0
heads <- 0

while (heads < 3) {
  if (flip() == "H") { # když padne hlava
    heads <- heads + 1 # připočti 1 k objektu heads
  } else {
    heads <- 0 # jinak heads vynuluj
  } 
  flips <- flips + 1 # počítej poček pokusů
}
flips


### Ukázka hromadného importu souborů
# Zkuste napsat for loop pro import všech .csv souborů v zadané složce
# do jednoho listu

# Vyhledání všech souborů, které končí příponou .sav, v podsložce data
files <- dir("data/", pattern = "\\.sav$", full.names = TRUE)
files

# Příprava jmen pro nově vytvořené objekty
df_names <- files %>% 
  str_remove_all(pattern = "(data/)|(.sav)") %>% 
  str_replace_all(pattern = " ", replacement = "_")
df_names

# Příprava outputu (typu list)
data_list <- vector("list", length = length(files)) %>% 
  set_names(df_names)
data_list

# Iterativní import dat
for (i in seq_along(data_list)) {
  data_list[[i]] <- haven::read_sav(files[[i]])
}

data_list %>% str(1)

# Exportovat prvky listu jako samostatné objekty do global environment 
list2env(data_list, envir=.GlobalEnv)

# Funkce map() -------------------------------------------------------

# Protože často potřebujeme provést určitou operaci pro několik vektorů
# a protože tvorba for loops může být zbytečně pracná, nabízí balíček
# purrr soubor funkcí, které iteraci značně usnadňují

# Tyto funkce se liší v závislosti na požadovaném outputu
  # map() vytvoří list.
  # map_lgl() vytvoří logical vector.
  # map_int() vytvoří integer vector.
  # map_dbl() vytvoří double vector.
  # map_chr() vytvoří character vector.
  # map_df() vytvoří tibble

# Použití těchto základních funkcí je poměrně jednoduché
# Prvním argumentem je vstupní vektor
map_dbl(df, mean)
map_dbl(df, median)
map_dbl(df, sd)

# Druhý argument .f je funkce, kterou chceme uplatnit, 
# může to být i formula, character vector nebo integer vektor

map_df(df, ~ (.x - mean(.x))/sd(.x))
map_dbl(df, 5)

# map používá dot-dot-dot ..., takže lze přidat jakékoli další argumenty
# pro použitou funkci
map_dbl(df, mean, trim = 0.5, na.rm = TRUE)


# map usnadňuje práci s více modely
# Dejme tomu, že chcete fitovat lineárně regresní model zvlášť pro jednotlivé
# skupiny

# Nejdříve pomocí funkce split rozdělíme dataframe na list dataframů podle
# proměnné cyl (počet válců)
mtcars_split <- mtcars %>% 
  split(.$cyl)

# Pak pro každý prvek listu zvlášť fitujeme stejný model
models <- mtcars_split %>% 
  map(~lm(mpg ~ wt, data = .x))

# Dosteneme list s jednotlivými fitovanými modely
models

# Pak si můžeme extrahovat různé souhrnné statistiky
models %>% 
  map(summary) %>% 
  map_dbl(~.x$r.squared) # pomocí formula

models %>% 
  map(summary) %>% 
  map_dbl("r.squared") # pomocí character vectoru

# Případně můžeme použít funkce z balíčku broom
models %>% 
  map_df(broom::tidy, .id = "cyl")

models %>% 
  map_df(broom::glance, .id = "cyl")

### Cvičení
# Použite map a patričnou funkci podle zadání
  
# Spočítejte průměr každého ze sloupců mtcars.

# Zjistěte typ (typeof) každého sloupce ve starwars.


# Zjistěte počet jedinečných hodnot, n_distinct(), v každém sloupci iris


# Generujte 10 náhodných hodnot z normálního rozdělení s průměry 
# -10, 0, 10, and 100

# Generate 10 random normals from distributions with means of -10, 0, 10, and 100.
c(-10, 0, 10, 100) %>% 
  map()

c(mu10neg = -10, mu0 = 0, mu10 = 10, mu100 = 100) %>% 
  map_df()

# pomocí map_lgl vytvořte logický vektor, který pro každý sloupec starwars
# indikuje, zda se jedná of factor


# Co dělá tento příkaz?
map(1:5, runif)
  
# Co dělá tento příkaz?
map(-2:2, rnorm, n = 5)

# Co dělá tento příkaz?
map(c(1, 10, 100), rnorm, n = 8, mean = 0)

# Proč tento příkaz nefunguje?
map_dbl(-2:2, rnorm, n = 5) 


# map() s více argumenty -------------------------------------------------

# Doposud jsme prováděli iterace pouze s jedním vstupním vektorem,
# ale často máme vstupních vektorů více, např. pokud bychom chtěli generovat 
# data z normální distribuce a měnit jak populační průměr, tak směrodatnou
# odchylku

# Pro podobné případy, kdy máme více vstupních vektorů, slouží funkce
# map2() a pmap()

# Dejme tomu, že chceme měnit jak mí, tak sigma
# Připravíme si dva vstupní vektory
mu <- list(5, 10, -3)
sigma <- list(1, 5, 10)

# A oba je vložíme do funkce map2 v pořadí, ve kterém je funce rnorm očekává
map2(mu, sigma, rnorm, n = 5)

# Případně použijeme ~formula, kde se pomocí .x odkazujeme na první input,
# a pomocí .y na druhý input
map2(mu, sigma, ~rnorm(5, mean = .x, sd = .y))

# I když by mohly existovat funkce map3(), map4(), map5(), map6() atd.,
# není to zapotřebí, protože existuje obecná funkce pmap(), která zvládá
# neomezené množství vstupních vektorů, pokud jsou součástí listu

# Do jednoho listu si uložíme vektory všech vstupních argumentů
# Nejlépe uděláme, pokud prvky listu nazveme  přesně podle názvů
# vstupních argumentů následně použité funkce, zde rnorm()
args(rnorm)

params <- list(
  n = c(1, 3, 5),
  mean = c(5, 10, -3),
  sd = c(1, 5, 10)
)

# A pak list vložíme do funce pmap a iterativně aplikujeme funkci rnorm
params %>%
  pmap(rnorm)


# Pro ještě sofistikovanější iterace můžeme (kromě toho, že měníme vstupní
# argumenty funkce), měnit i funkci samotnou

# Nejprve si vytvoříme vektor s názvy funkcí
fns <- c("runif", "rnorm", "rpois")

# Pak vektor se vstupními parametry
params <- list(
  list(min = -1, max = 1), 
  list(mean = 10, sd = 5), 
  list(lambda = 10)
)

# Pak použijeme funkci map2() následujícím způsobem:
map2(fns, params, ~exec(.x, !!!.y, n = 10)) %>% 
  set_names(fns)

# operátor !!! "nakrájí" list params na jednotlivé prvky
# exec iterativně spouští funkce v .x (první input map2) s parametry
# nastavenými v .y (druhý argument map2) plus s jakýmikoli dalšími argumenty,
# které mají být shodné pro všechny iterace, zde n = 10 (počet generovaných
# hodnot)


# funkce walk() -------------------------------------------------------------

# Funkce walk() je alternativou k funkci map(), pokud chceme spusti nějakou 
# funkci kvůli jejím vedlejším efektům, jako je tvorba grafu nebo uložení
# souboru na disk, nikoli kvůli jejím výstupním hodnotám a tvorbě nového
# datového objektu

# Tady je jednoduchá příklad s funkcí print()
x <- list(1, "a", 3)

x %>% 
  walk(print)

# Pomocí pwalk() např. můžeme uložit několik grafů zároveň
# Nejdříve si vytvoříme list s bodovými grafy proměnných mpg a wt pro jednotlivé
# úrovně cyl
plots <- mtcars %>% 
  split(.$cyl) %>% 
  map(~ggplot(., aes(wt, mpg)) + geom_point())

# Pak si připravíme jména výstupních souborů
plot_names <- str_c("cyl", names(plots), ".png")
plot_names

# Sloučíme obojí od jednoho listu, ten pak vložíme do funkce pwalk a iterativně
# uplatníme funkci ggsave
list(
  filename = plot_names, # ggsave má tyto dva hlavní argumenty: filename a plot
  plot = plots
) %>% 
  pwalk(ggsave, path = "plots")


# Predikativní funkce -----------------------------------------------------

# Dále balíček purrr nabízí soubor funkcí, které využívají jiné, predikativní
# funkce, která vracejí buď TRUE, nebo FALSE

# funkce keep() zachová prvky, pro které je predikát TRUE,
# funkce discard() naopak zahodí prvky, pro které je predikát FALSE

# Příklady
# Zachovat v datasetu iris pouze sloupce typu factor
iris %>% 
  keep(is.factor) %>% 
  str()

# Zachovat v datasetu iris pouze sloupce, které nejsou typu factor
iris %>% 
  discard(is.factor) %>% 
  str()

# funkce some() a every() ověřují, zda je nějaký predikát platný
# pro některý prvek, respektive pro všechny prvky

x <- list(1:5, letters, list(10))
x

x %>% 
  some(is.character) # je aspoň jeden prvek typu character?

x %>% 
  every(is.numeric) # jsou všechny prvky numerické?

