##%######################################################%##
#                                                          #
####                  Transformace dat                  ####
#                                                          #
##%######################################################%##


# Packages ----------------------------------------------------------------
library(nycflights13)
library(tidyverse)

# Introduction ------------------------------------------------------------
set.seed(123)
flights <- slice_sample(flights, n = 1e4)
?flights

# In this chapter you are going to learn the five key dplyr functions 
# that allow you to solve the vast majority of your data manipulation challenges:
  # Pick observations by their values (filter()).
  # Reorder the rows (arrange()).
  # Pick variables by their names (select()).
  # Create new variables with functions of existing variables (mutate()).
  # Collapse many values down to a single summary (summarise()).

# All verbs work similarly:
  # The first argument is a data frame.
  # The subsequent arguments describe what to do with the data frame, 
  # using the variable names (without quotes).
  # The result is a new data frame.

# Filter rows with filter() -----------------------------------------------

# filter() allows you to subset observations based on their values. 
# The first argument is the name of the data frame.
filter(flights, month == 1, day == 1)
filter(flights, month == 1 & day == 1)

# Comparison with base R
flights[flights$month == 1 & flights$day == 1, ]
subset(flights,  month == 1 & day == 1)

# Pokud si chcete přečíst o rozdílech mezi funkcemi filter() a subset()
# https://stackoverflow.com/questions/39882463/difference-between-subset-and-filter-from-dplyr 

# dplyr functions never modify their inputs, so if you want to save the result, 
# you’ll need to use the assignment operator, <-
jan1 <- filter(flights, month == 1, day == 1)

# R either prints out the results, or saves them to a variable. 
# If you want to do both, you can wrap the assignment in parentheses:
(dec25 <- filter(flights, month == 12, day == 25))

# To use filtering effectively, you have to know how to select the observations 
# that you want using the comparison operators. 
# R provides the standard suite: >, >=, <, <=, != (not equal), and == (equal).

# pro kombinaci více podmínek můžete použít tyto operátory
 # x & y znamená x a zároveň y
 # x | y znamená x anebo y (stačí splnění jedné podmínky) # ctrl + alt + W
 # xor(x, y) znamená buď, anebo (splnění právě jedné z podmínek, ne obou)

# Lety, které měly zpoždění na odletu více než hodninu
filter(flights, dep_delay > 60)

# Lety, které měly zpoždění na příletu více než hodninu
filter(flights, arr_delay > 60)

# Lety, které měly zpoždění na odletu a zároveň na příletu více než půl hodiny
filter(flights, dep_delay > 30, arr_delay > 30)
filter(flights, dep_delay > 30 & arr_delay > 30)

# Lety, které měly zpoždění na odletu anebo na příletu více než hodinu
filter(flights, dep_delay > 60 | arr_delay > 60)

# Lety, které měly zpoždění na odletu více než půl hodiny, ale žádné na příletu
filter(flights, dep_delay > 30, !arr_delay > 0)
filter(flights, dep_delay > 30, arr_delay <= 0)

# Lety, které neměly zpoždění na odletu, ale na příletu alespoň půlhodinové
filter(flights, !dep_delay > 0, arr_delay >= 30)
filter(flights, dep_delay <= 0, arr_delay >= 30)

# Lety, které měly alespoň půlhodinové zpoždění buď na odletu, nebo na příletu 
filter(flights, xor(dep_delay >= 30, arr_delay >= 30))

# The following code finds all flights that departed in the last trimestr:
filter(flights, month == 10 | month == 11 | month == 12)

# A useful short-hand for this problem is x %in% y
filter(flights, month %in% c(10, 11, 12))

# Lety, které odletělý v druhé polovině roku
filter(flights, between(month, 6, 12))


# * Missing values -------------------------------------------------
# If you want to determine if a value is missing, use is.na(), not x == NA
# Lety s chybějícimi hodnotami u dep_delay
filter(flights, is.na(dep_delay))

# filter() only includes rows where the condition is TRUE; 
# it excludes both FALSE and NA values. If you want to preserve missing values, 
# ask for them explicitly:

# Lety s chybějícím dep_delay anebo s větším než 2hodinových zpožděním
filter(flights, is.na(dep_delay) | dep_delay > 120)

# * Exercises -----------------------------------------------------
# Find all flights that...

# Had an arrival delay of two or more hours

# Flew to Houston (dest IAH or HOU)

# Were operated by United, American, or Delta (UA, AA, DL)

# Departed in summer (July, August, and September)

# Arrived more than two hours late, but didn’t leave late

# Were delayed by at least an hour, but made up over 30 minutes in flight

# Departed between midnight and 6am (inclusive)

# Arrange rows with arrange() ---------------------------------------------
# arrange() works similarly to filter() except that instead of selecting rows, 
# it changes their order. It takes a data frame and a set of column names 
# (or more complicated expressions) to order by. 
# If you provide more than one column name, each additional column will be used 
# to break ties in the values of preceding columns:
arrange(flights, year, month, day)

# Comparison with base R
row_id <- order(flights$year, flights$month, flights$day) # in two steps
flights[row_id, ]
flights[order(flights$year, flights$month, flights$day), ] # or in one step

# Use desc() to re-order by a column in descending order:
arrange(flights, desc(dep_delay))

# Missing values are always sorted at the end:
arrange(flights, desc(dep_delay)) %>% 
  tail()


# * Exercises -------------------------------------------------------------
# How could you use arrange() to sort all missing values to the start? 
# (Hint: use is.na()).


# Sort flights to find the most delayed flights on arrival. 


# Find the flights that left earliest.


# Sort flights to find the fastest (highest speed) flights.


# Which flights travelled the farthest? 


# Which travelled the shortest?


# Select columns with select() --------------------------------------------
# select() is not terribly useful with the flights data because we 
# only have 19 variables, but you can still get the general idea:

# Select columns by name (unquoted)
select(flights, year, month, day)

# Comparison with base R
flights[, c("year", "month", "day")]
flights[c("year", "month", "day")]
subset(flights, select = c(year, month, day))

# Select all columns between year and day (inclusive)
select(flights, year:day)

# Select all columns except those from year to day (inclusive)
select(flights, -(year:day))

# Select columns by number
select(flights, 4, 7)
select(flights, -c(1:3))
select(flights, c(1:4), -2)

# Select columns using a character vector
x <- c("dep_time", "arr_time", "air_time")
select(flights, all_of(x))

# Select columns by type
select(flights, where(is_character))
select(flights, where(is_integer))

# There are a number of helper functions you can use within select():
select(flights, starts_with("dep"))
select(flights, ends_with("time"))
select(flights, contains("arr"))

# There is also num_range() function,
# for example num_range("x", 1:3): matches x1, x2 and x3.
my_tibble <- tribble(
  ~x1, ~x2, ~x3, ~x4, ~x5, ~x6,
    1,   2,   3,   4,   5,   6,
    7,   8,   9,  10,  11,  12
)
my_tibble

select(my_tibble, num_range("x", 1:3))

# select() can be used to rename variables, but it’s rarely useful 
# because it drops all of the variables not explicitly mentioned. 
select(flights, departure_time = dep_time) # new_name = original_name

# Instead, use rename(), which is a variant of select() 
# that keeps all the variables that aren’t explicitly mentioned:
rename(flights, departure_time = dep_time)

# Another option is to use select() in conjunction with the everything() helper.
# This is useful if you have a handful of variables you’d like to move 
# to the start of the data frame.
select(flights, time_hour, air_time, everything())

# Sometimes you may want to mote the last column to the front
select(flights, last_col(), everything())


# * Exercises -------------------------------------------------------------

# Brainstorm as many ways as possible to select dep_time, dep_delay, 
# arr_time, and arr_delay from flights


# What happens if you include the name of a variable multiple times 
# in a select() call?


# What does the all_of() function do? 
# Why might it be helpful in conjunction with this vector?
vars <- c("year", "month", "day", "dep_delay", "arr_delay")


# Does the result of running the following code surprise you? 
# How do the select helpers deal with case by default? 
# How can you change that default?
select(flights, contains("TIME"))
?tidyselect::contains
args(contains)

# Add new variables with mutate() ----------------------------------------------

# For simplicity, we're gonna work with a smaller number of variables
flights_sml <- select(flights, 
                      year:day, 
                      ends_with("delay"), 
                      distance, 
                      air_time
)

mutate(flights_sml,
       gain = dep_delay - arr_delay, # získání "náskoku" (snížení zpoždění) během letu 
       speed = distance / air_time * 60 * 1.609 # průměrná rychlost v km/h
)

# Note that you can refer to columns that you’ve just created:
mutate(flights_sml,
       gain = dep_delay - arr_delay,
       hours = air_time / 60,
       gain_per_hour = gain / hours # získání "náskoku" (snížení zpoždění) během letu
                                    # za každou hodinu letu
)

# If you only want to keep the new variables, use transmute():
transmute(flights_sml,
          gain = dep_delay - arr_delay,
          hours = air_time / 60,
          gain_per_hour = gain / hours
)


# * Exercise ----------------------------------------------------------------

# Currently dep_time and sched_dep_time are convenient to look at, 
# but hard to compute with because they’re not really continuous numbers. 
# Convert them to a more convenient representation of number of minutes 
# since midnight.
# Nápověda: bude se vám hodit celočíselné dělení, tj. operátor %/% 
# a zbytek po celočíselném dělení, tj. operátor %%
# A pozor na to, že 2400 znamená začátek, ne konec daného dne


# Grouped summaries with summarise() --------------------------------------
# The last key verb is summarise(). It collapses a data frame to a single row:
summarise(flights, delay = mean(dep_delay, na.rm = TRUE))

# summarise() is not terribly useful unless we pair it with group_by()
by_day <- group_by(flights, year, month, day)
summarise(by_day, delay = mean(dep_delay, na.rm = TRUE))


# * Combining multiple operations with the pipe ---------------------------
flights %>% 
  group_by(year, month, day) %>% 
  summarise(delay = mean(dep_delay, na.rm = TRUE)) %>% 
  arrange(desc(delay))

# You may have wondered about the na.rm argument we used above. 
# What happens if we don’t set it?
flights %>% 
  group_by(year, month, day) %>% 
  summarise(delay = mean(dep_delay)) %>% 
  arrange(!is.na(delay))

# We get a lot of missing values! That’s because aggregation functions obey 
# the usual rule of missing values: if there’s any missing value in the input, 
# the output will be a missing value.
# we could also tackle the problem by first removing the cancelled flights. 
not_cancelled <- flights %>% 
  filter(!is.na(dep_delay), !is.na(arr_delay))

not_cancelled %>% 
  group_by(year, month, day) %>% 
  summarise(mean = mean(dep_delay))

# Whenever you do any aggregation, it’s always a good idea to include either 
# a count (n()), or a count of non-missing values (sum(!is.na(x)))
not_cancelled %>% 
  group_by(year, month, day) %>% 
  summarise(mean = mean(dep_delay),
            sd = sd(dep_delay),
            n = n())


# * Useful summary functions ----------------------------------------------

# Measures of location: we’ve used mean(x), but median(x) is also useful. 
not_cancelled %>% 
  group_by(year, month, day) %>% 
  summarise(
    Mdn_delay = median(arr_delay),
    Mdn_pos_delay = median(arr_delay[arr_delay > 0]), # median of positive delays
    M_pos_delay = mean(arr_delay),
    M_delay = mean(arr_delay[arr_delay > 0]) # the average positive delay
  )

# Measures of spread: sd(x), IQR(x), mad(x)
not_cancelled %>% 
  group_by(dest) %>% 
  summarise(SD_distance = sd(distance),
            IQR_distance = IQR(distance),
            MAD_distance = mad(distance))

# Measures of rank: min(x), quantile(x, 0.25), max(x). 
# Quantiles are a generalisation of the median. For example, 
# quantile(x, 0.25) will find a value of x that is greater than 25% 
# of the values, and less than the remaining 75%.
# Measures of spread: sd(x), IQR(x), mad(x)
not_cancelled %>% 
  group_by(year, month, day) %>% 
  summarise(
    Min = min(dep_time),
    q25 = quantile(dep_time, 0.25),
    Mdn = median(dep_time),
    q75 = quantile(dep_time, 0.75),
    Max = max(dep_time)
  )

# Counts: You’ve seen n(), which takes no arguments, and returns 
# the size of the current group. To count the number of non-missing values, 
# use sum(!is.na(x)). 
# To count the number of distinct (unique) values, use n_distinct(x)
flights %>%
  group_by(dest) %>% 
  summarise(
    n_all = n(),
    n_not_cancelled= sum(!is.na(dep_time) & !is.na(arr_time)),
    n_carriers = n_distinct(carrier)
  ) %>% 
  arrange(desc(n_all))

# Counts are so useful that dplyr provides a simple helper 
# if all you want is a count
flights %>% 
  count(dest)

flights %>% 
  count(dest, carrier)

# Useful custom functions --------------------------------------------------
rses <- haven::read_sav("data/rses_data.sav")
glimpse(rses) 

# Function to overview variable names, labels and value labels
overview <- function(data) {
  var_names <- colnames(data)
  var_labels <- map(data, attributes) %>% 
    map_chr(~.x$label)
  value_labels <- map(data, attributes) %>% 
    map(~.x$labels) %>% 
    map_chr(~str_c(.x, " = ", names(.x), collapse = "; "))
  value_labels[value_labels == " = "] <- NA_character_
  
  tibble(var_names, var_labels, value_labels)
}

ov <- overview(rses)
View(ov)

# Function to extract labels from vector attributes and convert to factor
fct_label <- function(x) {
  levs <- attributes(x)$labels
  labs <- names(levs)
  factor(x, levels = levs, labels = labs)
}

glimpse(rses)

rses <- rses %>% 
  mutate(
    sex = fct_label(sex)
  )

glimpse(rses)

# Set 99 in age as missing value
rses <- rses %>% 
  mutate(
    age = ifelse(age == 99, NA, age)
  )
glimpse(rses)

# Use across() to apply a function across multiple columns
rses <- rses %>% 
  mutate(
    across(
      c(id, age, rses01:rses10), as.integer
    )
  )

glimpse(rses)

# function to generate variable names
 # prefix = variable prefix
 # range = integer vector,
 # suffix = any suffix if needed,
 # width = add leading zeros to numeric range to keep selected width
var_range <- function(prefix, range, suffix = "", width = NULL) {
  range <- sprintf(
    paste0("%0.", width, "d"),
    range
  )
  paste0(prefix, range, suffix)
}

rses_items <- var_range(prefix = "rses", range = 1:10, width = 2)
rses_items

rses %>% 
  select(all_of(rses_items))


# Function to recode reversed scored items
  # data = dataframe
  # vars = variable to recode
  # min = minimum attainable item score
  # max = maximum attainable item score
  # drop = keep only newly created variables?
reverse <- function(data, vars, min, max, drop = FALSE) {
  data <- data %>% 
    mutate(
      across(all_of(vars), ~min + max - .x)
    )
  if (drop == TRUE) {
    data <- data %>% 
      select(all_of(vars))
  }
  return(data)
}

reversed_items <- var_range("rses", c(2, 5, 6, 8, 9), width = 2)
reversed_items

reverse(rses, vars = reversed_items, min = 1L, max = 6L)

rses_recoded <- reverse(rses, vars = reversed_items, min = 1L, max = 6L)
rses_recoded

# Function to compute number of missing values in a row
 # data = dataframe,
 # vars = character vector of variable (columns) names, 
     # if NULL (default), computes number of missing values across all columns
 # new_col = name of the new column created
 # drop = keep only newly created variable?
row_missing <- function(data, vars = NULL, new_col = "n_miss", drop = FALSE) {
  if (!is.null(vars)) {
    x <- data %>% 
      select(all_of(vars)) %>% 
      is.na() %>% 
      rowSums()
  } else {
    x <- data %>% 
      is.na() %>% 
      rowSums()
  }
  data[new_col] <- x
  if (drop == TRUE) {
    data[new_col]
  } else {
    data
  }
}

row_missing(rses)
row_missing(rses, drop = TRUE)

# Function to compute row means
  # data = dataframe, 
  # vars = character vector of variable (column) names
  # new_col = name of the new column created
  # max_na = maximum number of missing values (otherwise returns NA)
  # drop = keep only newly created variable?
row_mean <- function(data, vars, new_col = "total_score", max_na = 0, drop = FALSE) {
  slct <- data %>% 
    select(all_of(vars))
  
  n_miss <- slct %>% 
    is.na() %>% 
    rowSums()
  
  x <- slct %>% 
    rowMeans(na.rm = TRUE)
  
  x[n_miss > max_na] <- NA_real_
  data[, new_col] <- x
  
  if (drop == TRUE) {
    data[new_col]
  } else {
    data
  }
}

row_mean(rses, vars = rses_items, new_col = "rses_total")

# Summarising across multiple columns and using multiple functions
rses_recoded %>%
  filter(!is.na(sex)) %>% 
  group_by(sex) %>% 
  summarise(
   across(
     rses01:rses10, # selected variables 
     list(M = mean, # multiple functions supplied in a list
          SD = sd),
     na.rm = TRUE) # additional arguments for supplied functions
  )


