Funkcje


Do tej pory używaliśmy bardzo wielu funkcji, wbudowanych w różne pakiety. Zanim przejdziemy do pisania własnych, powtórzmy jak brzmią dobre praktyki używania argumentów funkcji na przykładzie funkcji mean() i merge().
Żeby dowiedzieć się w ogóle jakie ta funkcja przyjmuje argumenty, możemy wywołać dokumentację funkcji przez użycie znaku zapytania przed interesującą nas funkcją ?mean


Jeśli nie mamy wczytanego pakietu (library(...)), który zawiera interesująca nas funkcję, musimy podwoić znak zapytania, żeby rozszerzyć zakres poszukiwań o pakiety, których nie mamy ??mean.


Możemy też użyć funkcji args() na funkcji, której nazwy argumentów chcemy poznać.


args(mean)
## function (x, ...) 
## NULL
args(merge)
## function (x, y, ...) 
## NULL

Niewiele wzbogaciło to naszą wiedzę. Te NULLe i ... oznaczają, że args() nie pokazuje pełnej sygnatury funkcji. To się dzieje, gdy funkcje są generyczne (generic functions) albo mają skomplikowaną strukturę.

Lepsze sposoby sprawdzenia argumentów:

# pełna dokumentacja
?merge
?mean

Co otrzymujemy?



Postać uogólniona funkcji: mean(x, trim = 0, na.rm = FALSE, ...) 


str(mean)
## function (x, ...)
str(merge)
## function (x, y, ...)



Sposoby wywoływania argumentów funkcji:

  • mean(1:9, 0.1, TRUE, ...) -> po kolejności argumentów

  • mean(x = 1:9, trim = 0.1, na.rm = TRUE, ...) -> jawnie, z użyciem nazw argumentów/ parametrów funkcji

  • mean(1:9 , trim = 0.1, na.rm = TRUE, ...) -> miks, jawnie tylko te rzadko używane, “nieintuicyjne”



Why functions?

Dlaczego warto pisać własne funkcje, skoro mamy ich cały arsenał wbudowany w różne pakiety R?

  • Mniej kodu w skrypcie

  • Kod czytelniejszy

  • Łatwiej testować pojedynczą funkcję niż cały skrypt

  • Łatwiejsza modyfikacja, zmiana w jednym miejscu zamiast w wielu

  • Mniejsze ryzyko pomyłki podczas wielokrotnego robienia copy paste i modyfikowania skryptu w wielu miejscach

  • Własne funkcje mogą znaleźć zastosowanie w innych projektach, pracach, większa customizacja


Funkcje w R to nic innego jak kolejny obiekt, typ zmiennej (jak wektor, czy lista), dlatego tworząc funkcję, musimy ją do czegoś przypisać.


Frame work nowej funkcji wygląda następująco: 

# tworzenie
moja_funkcja <- function(){ 
  # Ciało funkcji - co funkcja ma zrobić
  "Tu się dzieje magia i przetwarzańsko"
  return("Cześć! Witaj w świecie funkcji w R!") # zrobić #!
}

# wywołanie
moja_funkcja()
## [1] "Cześć! Witaj w świecie funkcji w R!"


# tworzenie
nazwa_funkcji <- function(argument1, argument2) { # przy czym argumenty nie zawsze są obowiązkowe
  # Ciało funkcji - co funkcja ma zrobić
  wynik <- argument1 + argument2
  return(wynik)  # return() jest opcjonalne - R zwraca ostatnią wartość
}

# wywołanie
nazwa_funkcji(2,4)
## [1] 6


Funkcja może nie mieć żadnych parametrów (argumentów)

five <- function(){5L}
five()
## [1] 5



Funkcje nie wymagają nawiasów klamrowych, jeśli kod funkcji zawiera tylko jedno polecenie.

five <- function() 5L
five()
## [1] 5



Funkcje mogą zwracać kilka wartości.

iloraz <- function(a, b) {
  # Wrzucenie kilku informacji w listę
  wynik <- list("dzielna" = a,
                "dzielnik" = b,
                "wynik" = a/b)
  return(wynik) 
}

iloraz(10,5)
## $dzielna
## [1] 10
## 
## $dzielnik
## [1] 5
## 
## $wynik
## [1] 2




Dobre Praktyki


Nazewnictwo Używaj jasnych, opisowych nazw funkcji. Konwencje to snake_case (oblicz_srednia) lub camelCase (obliczSrednia). Unikaj jednoliterowych nazw i nazw konfliktujących z wbudowanymi funkcjami.

Struktura i czytelność Funkcje powinny robić jedną rzecz i robić ją dobrze. Jeśli funkcja ma więcej niż 20-30 linii, rozważ jej podział. Używaj wcięć i odstępów dla czytelności.

Argumenty Podawaj wartości domyślne dla opcjonalnych argumentów. Umieszczaj obowiązkowe argumenty na początku, opcjonalne na końcu. Sprawdzaj poprawność argumentów na początku funkcji używając stop() lub stopifnot().

Dokumentacja Zawsze dokumentuj swoje funkcje, najlepiej używając roxygen2. Opisz co funkcja robi, jakie przyjmuje argumenty, co zwraca i podaj przykłady użycia.

Wartości zwracane Używaj return() tylko gdy chcesz wcześniej zakończyć funkcję, w przeciwnym razie ostatnia wartość jest zwracana automatycznie. Zwracaj jeden spójny typ danych.

Zarządzanie środowiskiem Unikaj modyfikowania zmiennych globalnych. Jeśli musisz, używaj <<- świadomie. Funkcje powinny być samowystarczalne.

Obsługa błędów Używaj tryCatch() do obsługi błędów. Zwracaj informacyjne komunikaty błędów używając stop() z jasnym opisem problemu.



Obliczanie pól figur

Funkcja obliczająca pole kwadratu

# 
pole_kwadratu <- function(bok) {
  pole <- bok^2
  return(pole)
}

# Testowanie
pole_kwadratu(5)
## [1] 25
pole_kwadratu(10)
## [1] 100


Funkcja obliczająca pole prostokąta

# 
pole_prostokata <- function(dlugosc, szerokosc) {
  pole <- dlugosc * szerokosc
  return(pole)
}

# Testowanie
pole_prostokata(5, 3)
## [1] 15
pole_prostokata(dlugosc = 8, szerokosc = 4)  # argumenty nazwane
## [1] 32


Zamiana jednostek


Funkcja przeliczająca temperaturę z Celsjusza na Fahrenheita. Wzór: F = C × 9/5 + 32

#
celsius_na_fahrenheit <- function(celsius) {
  fahrenheit <- celsius * 9/5 + 32
  return(fahrenheit)
}

# Test
celsius_na_fahrenheit(0)   # powinno być 32
## [1] 32
celsius_na_fahrenheit(100) # powinno być 212
## [1] 212


Funkcja z domyślną wartością argumentu

# 
powitanie <- function(imie, pora_dnia = "dzień") {
  wiadomosc <- paste("Dzień dobry,", imie, "! Mam nadzieję, że masz miły", pora_dnia)
  return(wiadomosc)
}

# Różne wywołania
powitanie("Anna")
## [1] "Dzień dobry, Anna ! Mam nadzieję, że masz miły dzień"
powitanie("Jan", "wieczór")
## [1] "Dzień dobry, Jan ! Mam nadzieję, że masz miły wieczór"
powitanie("Maria", pora_dnia = "poranek")
## [1] "Dzień dobry, Maria ! Mam nadzieję, że masz miły poranek"


Funkcja z walidacją argumentów

# 
pierwiastek_kwadratowy <- function(x) {
  if (x < 0) {
    stop("Nie można obliczyć pierwiastka z liczby ujemnej!")
  }
  return(sqrt(x))
}

# Test
pierwiastek_kwadratowy(16)
## [1] 4
pierwiastek_kwadratowy(-4)



Hazard


Rzut monetą

rzut_moneta <- function(){
  moneta <- c("orzeł", "reszka")
  sample(moneta, # ?sample
         size = 1) # a non-negative integer giving the number of items to choose
  }
# użycie
rzut_moneta()
## [1] "orzeł"



Wielokrotny rzut monetą

rzut_moneta <- function(LiczbaRzutow) {
  moneta <- c("orzeł", "reszka")
  sample(moneta, 
         size = LiczbaRzutow, 
         replace = TRUE) # <- should sampling be with replacement?
  }
# użycie
rzut_moneta(6)
## [1] "reszka" "reszka" "reszka" "orzeł"  "orzeł"  "reszka"



Rzut monetą niewyważoną

rzut_moneta <- function(LiczbaRzutow, prawdopodobienstwo_Orla) {
  
  moneta <- c("orzeł", "reszka")
  
  waga <- c(prawdopodobienstwo_Orla,
            1 - prawdopodobienstwo_Orla)
  
  sample(x = moneta,
         size = LiczbaRzutow, 
         replace = TRUE, 
         prob = waga) # a vector of probability weights for obtaining the elements of the vector being sampled
}

# użycie i statystyki rzutów
janitor::tabyl(
  rzut_moneta(100, .8)
  )
##  rzut_moneta(100, 0.8)  n percent
##                  orzeł 73    0.73
##                 reszka 27    0.27


Rzut monetą wyważoną, bądź inną - ustawianie domyślnych argumentów funkcji

rzut_moneta <- function(LiczbaRzutow, prawdopodobienstwo_Orla = .5) {
  
  moneta <- c("orzeł", "reszka")
  
  waga <- c(prawdopodobienstwo_Orla,
            1 - prawdopodobienstwo_Orla)
  
  sample(x = moneta,
         size = LiczbaRzutow, 
         replace = TRUE, 
         prob = waga)
}
# użycie i statystyki rzutów
janitor::tabyl(
  rzut_moneta(100)
  )
##  rzut_moneta(100)  n percent
##             orzeł 49    0.49
##            reszka 51    0.51


Rzut monetą - obsługa błędów

rzut_moneta <- function(LiczbaRzutow, prawdopodobienstwo_Orla = .5) {
  
  if(prawdopodobienstwo_Orla > 1) {
    stop(cat("Prawdopodobieństwo to nie stachanowiec, żeby robić normy powyżej 100%"))
    }
  
  moneta <- c("orzeł", "reszka")
  
  waga <- c(prawdopodobienstwo_Orla,
            1 - prawdopodobienstwo_Orla)
  
  sample(x = moneta,
         size = LiczbaRzutow, 
         replace = TRUE, 
         prob = waga)
}


# użycie i statystyki rzutów
janitor::tabyl(
  rzut_moneta(100, 1.2)
  )

Wyjaśnienie: stachanowiec «uczestnik współzawodnictwa pracy w ZSRR i w krajach komunistycznych w latach 1935–1950»
za: Słownik języka polskiego pod red. W. Doroszewskiego*



Rzut monetą z poprawką argumentu

rzut_moneta <- function(LiczbaRzutow, prawdopodobienstwo_Orla = .5) {
  
  if(prawdopodobienstwo_Orla > 1) {
    prawdopodobienstwo_Orla = .5
    cat(paste0("\n Prawdopodobieństwo to nie stachanowiec, żeby robić normy powyżej 100%, przyjęto zatem prawdopodobieństwo idealnie wyważonych monet: \n", 
               " _   _         _  _          _   __ _\\\n| | | |  ___  | || |  ___   | | / /(_)  _     _\\\n| |_| | / _ \\ | || | / _ \\  | |/ /  _ _| |_ _| |_  _  _\\\n|  _  |/ /_\\ \\| || |/ / \\ \\ |   /  | |_   _|_   _|| |/ /\\\n| | | |\\ ,___/| || |\\ \\_/ / | |\\ \\ | | | |_  | |_ | / /\\\n|_| |_| \\___/ |_||_| \\___/  |_| \\_\\|_| \\___| \\___||  /\\\n                       _           _              / /\\\n                      / \\_______ /|_\\             \\/\\\n                     /          /_/ \\__\\\n                    /             \\_/ /\\\n                  _|_              |/|_\\\n                  _|_  O    _    O  _|_\\\n                  _|_      (_)      _|_\\\n                   \\                 /\\\n                    _\\_____________/_\\\n                   /  \\/  (___)  \\/  \\\\\n                   \\__(  o     o  )__/\\\n"))
    }
  
  moneta <- c("orzeł", "reszka")
  
  waga <- c(prawdopodobienstwo_Orla,
            1 - prawdopodobienstwo_Orla)
  
  sample(x = moneta,
         size = LiczbaRzutow, 
         replace = TRUE, 
         prob = waga)
}


# użycie i statystyki rzutów
janitor::tabyl(
  rzut_moneta(100, 1.2)
  )
## 
##  Prawdopodobieństwo to nie stachanowiec, żeby robić normy powyżej 100%, przyjęto zatem prawdopodobieństwo idealnie wyważonych monet: 
##  _   _         _  _          _   __ _\
## | | | |  ___  | || |  ___   | | / /(_)  _     _\
## | |_| | / _ \ | || | / _ \  | |/ /  _ _| |_ _| |_  _  _\
## |  _  |/ /_\ \| || |/ / \ \ |   /  | |_   _|_   _|| |/ /\
## | | | |\ ,___/| || |\ \_/ / | |\ \ | | | |_  | |_ | / /\
## |_| |_| \___/ |_||_| \___/  |_| \_\|_| \___| \___||  /\
##                        _           _              / /\
##                       / \_______ /|_\             \/\
##                      /          /_/ \__\
##                     /             \_/ /\
##                   _|_              |/|_\
##                   _|_  O    _    O  _|_\
##                   _|_      (_)      _|_\
##                    \                 /\
##                     _\_____________/_\
##                    /  \/  (___)  \/  \\
##                    \__(  o     o  )__/\
##  rzut_moneta(100, 1.2)  n percent
##                  orzeł 51    0.51
##                 reszka 49    0.49



Funkcja obliczająca różne miary statystyczne.

# Funkcja licząca średnią i odchylenie standardowe
stat_summary <- function(x) {
  list(
    mean = mean(x),
    sd = sd(x)
  )
}

# Przykład użycia
stat_summary(iris$Sepal.Length)
## $mean
## [1] 5.843333
## 
## $sd
## [1] 0.8280661


# Funkcja licząca średnią, medianę, odchylenie standardowe i zakres
summary_stats <- function(x) {
  
  if (!is.numeric(x)) {
    stop("Dane muszą być liczbowe!")
  }
  stats <- list(
    mean = mean(x, na.rm = TRUE),
    median = median(x, na.rm = TRUE),
    sd = sd(x, na.rm = TRUE),
    range = range(x, na.rm = TRUE)
  )
  return(stats)
}

# Przykład użycia
summary_stats(iris$Sepal.Length)
## $mean
## [1] 5.843333
## 
## $median
## [1] 5.8
## 
## $sd
## [1] 0.8280661
## 
## $range
## [1] 4.3 7.9
# summary_stats(iris$Species)


# Funkcja zwracająca statystyki opisowe
statystyki <- function(x, na.rm = TRUE) {
  wynik <- list(
    srednia = mean(x, na.rm = na.rm),
    mediana = median(x, na.rm = na.rm),
    odchylenie_std = sd(x, na.rm = na.rm),
    minimum = min(x, na.rm = na.rm),
    maksimum = max(x, na.rm = na.rm),
    zakres = max(x, na.rm = na.rm) - min(x, na.rm = na.rm),
    n = length(x),
    n_brakujacych = sum(is.na(x))
  )
  return(wynik)
}

# Test
dane <- c(5, 10, 15, 20, 25, NA, 30)
statystyki(dane)
## $srednia
## [1] 17.5
## 
## $mediana
## [1] 17.5
## 
## $odchylenie_std
## [1] 9.354143
## 
## $minimum
## [1] 5
## 
## $maksimum
## [1] 30
## 
## $zakres
## [1] 25
## 
## $n
## [1] 7
## 
## $n_brakujacych
## [1] 1


Proszę zauważyć, że w sumie tylko wrappujemy inne funkcje, ale pozwala nam to oszczędzać czas, automatyzować analizę i pozwala uniknąć powtarzania tych samych poleceń dla różnych wektorów.

własna konkatenacja


Funkcje mogą nie zawierać zdefiniowanych argumentów, przykład.

polacz_teksty <- function(...) {
  paste0(...)
  }

polacz_teksty("k", "o", "gnity", "wistyk", "a")
## [1] "kognitywistyka"



Funkcje mogą zawierać zarówno argumenty zdefiniowane jak i niezdefiniowane.

polacz_teksty <- function(..., separator = " # ") {
  paste(..., sep = separator)
  }
  
polacz_teksty("Koniec", "Zajęć", "Już", "Bliski")
## [1] "Koniec # Zajęć # Już # Bliski"



Rysowańsko


Funkcja tworząca wykres średnich dla każdej grupy

plot_group_means <- function(data, group_col, value_col) {
  library(ggplot2)
  
  # Sprawdzanie, czy kolumny istnieją
  if (!all(c(group_col, value_col) %in% names(data))) {
    stop("Podane kolumny nie istnieją w danych.\n Stoppen! Die angegebenen Spalten sind in den Daten nicht vorhanden.")
  }
  
  # Obliczanie średnich
  means <- aggregate(data[[value_col]], by = list(data[[group_col]]), FUN = mean)
  names(means) <- c("Group", "Mean")
  
  # Tworzenie wykresu
  ggplot(means, aes(x = Group, y = Mean, fill = Group)) +
    geom_bar(stat = "identity", show.legend = FALSE) +
    theme_minimal() +
    labs(
      title = "Średnie wartości według grup",
      x = group_col,
      y = value_col
    )
}

# Przykład użycia
plot_group_means(iris, group_col = "Species", value_col = "Sepal.Length")

plot_group_means(iris, group_col = "Species", value_col = "Sepal.Width")

plot_group_means(iris, group_col = "Species", value_col = "Wartosc_Bitcoin")


Funkcja filtrująca i podsumowująca dane

# 
podsumuj_po_grupie <- function(df, kolumna_grupa, kolumna_wartosci) {
  if (!kolumna_grupa %in% names(df) || !kolumna_wartosci %in% names(df)) {
    stop("Podane kolumny nie istnieją w ramce danych!")
  }
  
  wynik <- aggregate(
    df[[kolumna_wartosci]], 
    by = list(Grupa = df[[kolumna_grupa]]),
    FUN = function(x) c(
      srednia = mean(x, na.rm = TRUE),
      suma = sum(x, na.rm = TRUE),
      n = length(x)
    )
  )
  
  return(wynik)
}

# Test z wbudowanym zbiorem danych
data(iris)
(podsumuj_po_grupie(iris, "Species", "Sepal.Length"))
##        Grupa x.srednia  x.suma     x.n
## 1     setosa     5.006 250.300  50.000
## 2 versicolor     5.936 296.800  50.000
## 3  virginica     6.588 329.400  50.000



# Funkcja licząca częstość występowania słów
word_frequency <- function(text) {
  library(stringr)
  
  # Czyszczenie tekstu
  clean_text <- tolower(text)
  clean_text <- str_replace_all(clean_text, "[^a-z\\s]", "")
  
  # Dzielenie na słowa i liczenie
  words <- unlist(str_split(clean_text, "\\s+"))
  janitor::tabyl(words)
}

# Przykład użycia
text <- "R to wspaniały język. R jest bardzo popularny!"
word_frequency(text)
##      words n percent
##     bardzo 1   0.125
##       jest 1   0.125
##       jzyk 1   0.125
##  popularny 1   0.125
##          r 2   0.250
##         to 1   0.125
##   wspaniay 1   0.125

BTW

# install.packages("gutenbergr")
library(gutenbergr)

# Wyszukiwanie książki
books <- gutenberg_works() # wszystkie

# konkretna
book <- gutenberg_works(title == "Anne of Green Gables") # jedna z moich ulubionych

# Sprawdzenie, czy książka została znaleziona
if (nrow(book) > 0) {
  # Pobieranie tekstu książki
  ksiazka <- gutenberg_download(book$gutenberg_id) # Pobieranie tekstu książki po indkesie
  
  # Wyświetlanie pierwszych kilku wierszy tekstu
  print(head(ksiazka, 3))
} else {
  print("Nie znaleziono książki o podanym tytule.")
}
## # A tibble: 0 × 2
## # ℹ 2 variables: gutenberg_id <int>, text <chr>


Funkcja, którą stworzyliśmy wcześniej, użyta na tekście literackim, który pozyskaliśmy przed momentem.

DT::datatable(
  word_frequency(ksiazka$text[100:159])
  )



kalkulator BMI

# Funkcja obliczająca BMI i klasyfikująca wynik
bmi_calculator <- function(weight, height) {
  bmi <- weight / (height^2)
  category <- ifelse(bmi < 18.5, "Niedowaga",
                     ifelse(bmi < 25, "Norma",
                            ifelse(bmi < 30, "Nadwaga", "Otyłość")))
  return(list(BMI = bmi, Category = category))
}

# Przykład użycia
bmi_calculator(weight = 103, height = 1.93)
## $BMI
## [1] 27.65175
## 
## $Category
## [1] "Nadwaga"
bmi_calculator(70, 1.75)
## $BMI
## [1] 22.85714
## 
## $Category
## [1] "Norma"


# Funkcja obliczająca BMI z walidacją
oblicz_bmi <- function(waga, wzrost) {
  # Sprawdzanie czy argumenty są liczbami
  if (!is.numeric(waga) || !is.numeric(wzrost)) {
    stop("Waga i wzrost muszą być liczbami!")
  }
  
  # Sprawdzanie logicznych wartości
  if (waga <= 0 || wzrost <= 0) {
    stop("Waga i wzrost muszą być większe od zera!")
  }
  
  bmi <- waga / (wzrost^2)
  
  # Klasyfikacja BMI
  if (bmi < 18.5) {
    kategoria <- "niedowaga"
  } else if (bmi < 25) {
    kategoria <- "waga prawidłowa"
  } else if (bmi < 30) {
    kategoria <- "nadwaga"
  } else {
    kategoria <- "otyłość"
  }
  
  wynik <- list(bmi = round(bmi, 2), kategoria = kategoria)
  return(wynik)
}

# Test
oblicz_bmi(103, 1.93)
## $bmi
## [1] 27.65
## 
## $kategoria
## [1] "nadwaga"


oblicz_bmi(0, 1.80)
oblicz_bmi(100, 0)


Analiza porównawcza wektorów

porownaj_wektory <- function(x, y) {
  # Sprawdzanie długości
  if (length(x) != length(y)) {
    stop("Wektory muszą mieć taką samą długość!")
  }
  
  # Obliczanie korelacji
  korelacja <- cor(x, y, use = "complete.obs")
  
  # Tworzenie wykresu
  plot(x, y, 
       main = paste("Korelacja:", round(korelacja, 3)),
       xlab = "Wektor X",
       ylab = "Wektor Y",
       pch = 19,
       col = "steelblue")
  abline(lm(y ~ x), col = "red", lwd = 2)
  
  # Statystyki
  wynik <- list(
    korelacja = korelacja,
    srednia_x = mean(x, na.rm = TRUE),
    srednia_y = mean(y, na.rm = TRUE),
    roznica_srednich = mean(y, na.rm = TRUE) - mean(x, na.rm = TRUE),
    n = length(x)
  )
  
  return(wynik)
}

# Test
x <- rnorm(100, 50, 10)
y <- x + rnorm(100, 5, 5)
porownaj_wektory(x, y)

## $korelacja
## [1] 0.8534037
## 
## $srednia_x
## [1] 50.09415
## 
## $srednia_y
## [1] 55.62513
## 
## $roznica_srednich
## [1] 5.530982
## 
## $n
## [1] 100



normalizacja i standaryzacja

Czy pamiętacie Państwo czym jest normalizacja i standaryzacja?


Normalizacja przekształca dane tak, aby mieściły się w określonym przedziale, zwykle od 0 do 1.
Używamy kiedy skale zmiennych różnią się między sobą (np. zarobki w złotówkach i wiek w latach).
Stosujemy przy modelach wrażliwych na różnice w skali, takich jak metody klastrowania czy algorytmy oparte na miarach odległości (np. algorytmy k-NN lub SVM).

\[ x' = \frac{x - \min(x)}{\max(x) - \min(x)} \]


Standaryzacja przekształca dane tak, aby miały średnią równą 0 i odchylenie standardowe równe 1.
Dane są wówczas wyrażone w jednostkach odchyleń standardowych.
Wynikiem jest tzw. z-score (wynik standardowy), który mówi, ile jednostek odchylenia standardowego dana wartość znajduje się od średniej. Stosujemy przy modelach opartych na wagach cech, np. regresji liniowej czy sieciach neuronowych.

\[ z = \frac{x - \mu}{\sigma} \]



Funkcja normalizująca i standaryzująca wektor (albo zmienną).

transform_vector <- function(x, method = c("normalize", "standardize")) {
  method <- match.arg(method)
  if (!is.numeric(x)) stop("Dane muszą być liczbowe!")
  
  if (method == "normalize") {
    return((x - min(x, na.rm = TRUE)) / (max(x, na.rm = TRUE) - min(x, na.rm = TRUE)))
  } else if (method == "standardize") {
    return((x - mean(x, na.rm = TRUE)) / sd(x, na.rm = TRUE))
  }
}

Zastosowanie

(dane <- c(2, 4, 6, 8, 10))
## [1]  2  4  6  8 10
transform_vector(dane, method = "normalize")
## [1] 0.00 0.25 0.50 0.75 1.00
transform_vector(dane, method = "standardize")
## [1] -1.2649111 -0.6324555  0.0000000  0.6324555  1.2649111
# transform_vector(dane)



Braki danych - raport

# Funkcja identyfikująca brakujące dane w ramce
missing_data_report <- function(df) {
  report <- sapply(df, function(col) { # ?col
    sum(is.na(col))
  })
  return(as.data.frame(report))
}

# Przykład użycia
df <- data.frame(
  x = c(1, 2, NA, 4, NA),
  y = c("A", NA, "C", "D", "E"),
  z = c(TRUE, TRUE, NA, FALSE, F)
)
missing_data_report(df)
##   report
## x      2
## y      1
## z      1


Rabaty

Funkcja, która oblicza cenę po rabacie

rabat <- function(cena, procent_rabatu = 10) {
  if (!is.numeric(cena) || !is.numeric(procent_rabatu)) {
    stop("Cena i rabat muszą być liczbami!")
  }
  if (cena < 0 || procent_rabatu < 0 || procent_rabatu > 100) {
    stop("Nieprawidłowe wartości! Cena i rabat muszą być dodatnie, rabat max 100%.")
  }
  
  cena_po_rabacie <- cena * (1 - procent_rabatu/100)
  return(cena_po_rabacie)
}

# Test
rabat(100)      # 90
## [1] 90
rabat(100, 20)  # 80
## [1] 80


Elastiko

Funkcja przyjmująca dowolną liczbę argumentów

# 
suma_kwadratow <- function(...) {
  wartosci <- c(...)
  suma <- sum(wartosci^2)
  return(suma)
}

# Test z różną liczbą argumentów
suma_kwadratow(1, 2, 3)
## [1] 14
suma_kwadratow(1, 2, 3, 4, 5)
## [1] 55


# Generator funkcji potęgowych
stworz_potege <- function(n) {
  funkcja_potegowa <- function(x) {
    return(x^n)
  }
  return(funkcja_potegowa)
}

# Tworzenie specjalizowanych funkcji
kwadrat <- stworz_potege(2)
szescian <- stworz_potege(3)

kwadrat(5)  # 25
## [1] 25
szescian(5) # 125
## [1] 125



Instrukcje warunkowe


Instrukcja if(){}


Do czego jest nam potrzebny taki konstrukt? Jeśli chcemy, aby zestaw poleceń był wykonany tylko w przypadku spełnienia pewnego warunku, możemy własnie wykorzystać instrukcję warunkową.


Podstawowa składnia: if ( WARUNEK ) { POLECENIA }.


Najprostsza forma instrukcji warunkowej sprawdza jeden warunek.

# Przykład 1: Sprawdzanie wieku
(wiek <- 18)
## [1] 18
if (wiek == 18) {
  print("Osoba pełnoletnia")
}
## [1] "Osoba pełnoletnia"
# Przykład 2: Sprawdzanie temperatury
(temperatura <- 30)
## [1] 30
if (temperatura == 30) {
  print("Gorący dzień!")
}
## [1] "Gorący dzień!"
# Przykład 3: Poniżej zera
(x <- -666)
## [1] -666
if(x < 0){ # warunek
  print("x mniejsze od zera") # wyrażenie
}
## [1] "x mniejsze od zera"


Zwróciło oczekiwaną przez nas sentencję


Co w sytuacji, gdy nasza zmienna będzie dodatnia?

(x <- 666)
## [1] 666
if(x < 0){
  print("x mniejsze od zera")
}


Nic się nie wydarza, obsłużmy zatem ten przypadek


if(x < 0){
  print("x mniejsze od zera")
  } else {
  print("x większe od zera")
  }
## [1] "x większe od zera"
# można też w jednej linii, bez użycia nawiasów klamrowych

if(x > 0) print("x większe od zera") else print("x mniejsze od zera")
## [1] "x większe od zera"



Podstawowa składnia: if ( WARUNEK ) { jeśli TAK } else { jeśli NIE }


Zauważamy, że 0 nie jest ani dodatnie, ani ujemne. Możemy zatem między if a else, wrzucić jeszcze else if.


Zobaczmy

(x = 0)
## [1] 0
if(x < 0){
    print("x mniejsze od zera")
  } else if(x == 0){
    print("x równa się zero")
  } else {
    print("x większe od zera")
  }
## [1] "x równa się zero"


Przypadek na kategoryzację ocen.

ocena <- 4

if (ocena == 5) {
  "bardzo dobry"
  } else if (ocena == 4) {
    "dobry"
    } else if (ocena == 3) {
      "dostateczny"
      } else {
        "niedostateczny"
        }
## [1] "dobry"


Logika wektorowa


x <- c(3, 7, 10)

any(x > 5)  # czy istnieje?
## [1] TRUE
all(x > 5)  # czy wszystkie?
## [1] FALSE


W kontekście instrukcji warunkowej for()

if (all(x > 0)) {
  "Wszystkie dodatnie"
}
## [1] "Wszystkie dodatnie"
x <- c(-3, 7, 10)
if (all(x > 0)) {
  "Wszystkie dodatnie"
}
x <- c(3, 7, 10)
if (any(x > 0)) {
  "któraś na pewno większa"
}
## [1] "któraś na pewno większa"


Podstawowa składnia:

if ( WARUNEK_1 ) { jeśli TAK } else if ( WARUNEK_2 ) { jeśli TAK} else if ... else { w pozostałych przypadkach}

Mamy również dostęp do wektorowej wersji instrukcji if(), jest nią instrukcja ifelse(). Rozważmy taki przykład

(wektor_liczba <- c(-3:4))
## [1] -3 -2 -1  0  1  2  3  4
ktore_jakie <- ifelse(wektor_liczba > 0, # test
                       "liczba dodatnia", # yes
                       "liczba ujemna") # no

names(wektor_liczba) <- ktore_jakie

wektor_liczba
##   liczba ujemna   liczba ujemna   liczba ujemna   liczba ujemna liczba dodatnia 
##              -3              -2              -1               0               1 
## liczba dodatnia liczba dodatnia liczba dodatnia 
##               2               3               4


Polecenie (instrukcję) ifelse() można wielokrotnie zagnieżdżać, co zaraz zobaczymy, żeby poprawić poprzedni przykład

(wektor_liczba <- c(-3:4))
## [1] -3 -2 -1  0  1  2  3  4
ifelse(wektor_liczba > 0, "liczba dodatnia", 
       ifelse(wektor_liczba == 0, "zero",
              ifelse(wektor_liczba < 0, "liczba ujemna", "Inny przypadek"
                     )
              )
       )
## [1] "liczba ujemna"   "liczba ujemna"   "liczba ujemna"   "zero"           
## [5] "liczba dodatnia" "liczba dodatnia" "liczba dodatnia" "liczba dodatnia"


Wiele zagnieżdżonych warunków możemy również obsłużyć innym poleceniem z pakietu dplyr. Zobaczmy

(wektor_liczba <- c(-3:4))
## [1] -3 -2 -1  0  1  2  3  4
dplyr::case_when(wektor_liczba  > 0 ~ "liczba dodatnia", 
                 wektor_liczba  < 0 ~ "liczba ujemna",
                 wektor_liczba == 0 ~ "zero")
## [1] "liczba ujemna"   "liczba ujemna"   "liczba ujemna"   "zero"           
## [5] "liczba dodatnia" "liczba dodatnia" "liczba dodatnia" "liczba dodatnia"


Jest to bardzo czytelna funkcja. Możemy dać nieskończenie wiele warunków pamiętając jedynie, żeby zachować konwencję składniową i między warunkiem logicznym a operacją dać tyldę ~, trzymać porządek argumentów, bo ich kolejność ma znaczenie, bowiem są przetwarzane w podanej kolejności 


(wektor_liczba <- c(-3:4))
## [1] -3 -2 -1  0  1  2  3  4
ifelse(wektor_liczba >= -1 & wektor_liczba <= 1, # przykład warunku złożonego I
       "w przedziale [1,1]", 
       "poza przedziałem [1,1]")
## [1] "poza przedziałem [1,1]" "poza przedziałem [1,1]" "w przedziale [1,1]"    
## [4] "w przedziale [1,1]"     "w przedziale [1,1]"     "poza przedziałem [1,1]"
## [7] "poza przedziałem [1,1]" "poza przedziałem [1,1]"
# alternatywnie
ifelse(wektor_liczba < -1 | wektor_liczba > 1, # przykład warunku złożonego LUB
       "poza przedziałem [1,1]",
       "w przedziale [1,1]")
## [1] "poza przedziałem [1,1]" "poza przedziałem [1,1]" "w przedziale [1,1]"    
## [4] "w przedziale [1,1]"     "w przedziale [1,1]"     "poza przedziałem [1,1]"
## [7] "poza przedziałem [1,1]" "poza przedziałem [1,1]"
dplyr::case_when(wektor_liczba < -1 | wektor_liczba > 1 ~ "poza przedziałem [1,1]",
                 TRUE ~ "w przedziale [1,1]") # Można stosować taką konwencję dla "wszystkich pozostałych"
## [1] "poza przedziałem [1,1]" "poza przedziałem [1,1]" "w przedziale [1,1]"    
## [4] "w przedziale [1,1]"     "w przedziale [1,1]"     "poza przedziałem [1,1]"
## [7] "poza przedziałem [1,1]" "poza przedziałem [1,1]"



Przypomnienie operatorów relacyjnych i logicznych z zajęć nr 1

Operatory relacyjne:

  • == - równe
  • != - różne
  • <=, >= - mniejsze równe, większe równe
  • <, > - mniejsze, większe

Operatory logiczne:

  • & - koniunkcja (i), iloczyn zdań logicznych
  • | - alternatywa (lub), suma zdań logicznych
  • ! - negacja (zaprzeczenie - nie) zdania logicznego




Instrukcja (pętla) while(){}

Pętla repetycyjna (pętla warunkowa) to rodzaj pętli, w której wykonanie kolejnej iteracji uzależnione jest od pewnego, zdefiniowanego przez nas warunku.


Jest składniowo bardzo podobna do instrukcji if. Instrukcja warunkowa while służy do wielokrotnego sprawdzania warunku, aż nie będzie on spełniony.

Rzućmy okiem

x = 1

while(x <= 10){
  print(paste("X wynosi: ", x))
  x <- x + 1 # <- inkrementacja
}
## [1] "X wynosi:  1"
## [1] "X wynosi:  2"
## [1] "X wynosi:  3"
## [1] "X wynosi:  4"
## [1] "X wynosi:  5"
## [1] "X wynosi:  6"
## [1] "X wynosi:  7"
## [1] "X wynosi:  8"
## [1] "X wynosi:  9"
## [1] "X wynosi:  10"


A jaka jest aktualna wartość x?

print(x)
## [1] 11


x <- x + 1 <- inkrementacja, kluczowy element, co by się stało, gdybyśmy nie mieli w kodzie tego elementu? Proszę sprawdzić na na swoich komputerach…



Możemy nasze funkcje zagnieżdżać, np. niech nasza pętla “się kręci” do momentu uzyskania liczby podzielnej przez 7

x = 1

while(x <= 10){
  if(x %% 7 == 0) { # %% -> Modulo: operacja wyznaczania reszty z dzielenia (przypomnienie z zajęć 1)
    break
    }
  print(paste0("X wynosi: ", x))
  x <- x + 1
}
## [1] "X wynosi: 1"
## [1] "X wynosi: 2"
## [1] "X wynosi: 3"
## [1] "X wynosi: 4"
## [1] "X wynosi: 5"
## [1] "X wynosi: 6"


A ile wynosi x?

print(x)
## [1] 7


Zadanie, jak należałoby zmodyfikować powyższy kod, żeby “wydrukował” w konsoli również informację o ostatniej wartości jaką ma x, czyli 7? 



x = 1

while(x <= 10){
  if(x %% 7 == 0) { # %% -> Modulo: operacja wyznaczania reszty z dzielenia (przypomnienie z zajęć 1)
    break
    }
  x <- x + 1
  print(paste0("X wynosi: ", x))
}
## [1] "X wynosi: 2"
## [1] "X wynosi: 3"
## [1] "X wynosi: 4"
## [1] "X wynosi: 5"
## [1] "X wynosi: 6"
## [1] "X wynosi: 7"

versus

x = 1

while(x <= 10){
  if(x %% 7 == 0) { # %% -> Modulo: operacja wyznaczania reszty z dzielenia (przypomnienie z zajęć 1)
    break
    }
  x <- x +1
}
print(paste0("X wynosi: ", x))
## [1] "X wynosi: 7"


Suma liczb do momentu przekroczenia 20

suma <- 0
i <- 1

while (suma <= 20) {
  suma <- suma + i
  i <- i + 1
}

suma
## [1] 21


Losowanie liczby aż trafi się 6

liczba <- 0

while (liczba != 6) { # <- Pętla będzie się wykonywać tak długo, jak liczba różna od 6.
  liczba <- sample(1:6, 1)
  print(liczba)
}
## [1] 4
## [1] 5
## [1] 2
## [1] 2
## [1] 2
## [1] 6


Użycie break

i <- 1

while (TRUE) {
  print(i)
  if (i == 10) {
    break # break przerywa pętlę niezależnie od warunku
  }
  i <- i + 1
}
## [1] 1
## [1] 2
## [1] 3
## [1] 4
## [1] 5
## [1] 6
## [1] 7
## [1] 8
## [1] 9
## [1] 10


Użycie next (pominięcie iteracji)

i <- 0

while (i < 10) {
  i <- i + 1
  if (i == 6) { # Liczba 6 nie zostanie wypisana.
    next
  }
  print(i)
}
## [1] 1
## [1] 2
## [1] 3
## [1] 4
## [1] 5
## [1] 7
## [1] 8
## [1] 9
## [1] 10



Instrukcja (pętla) repeat(){}


Polecenie repeat() generuje pętlę, w której żaden warunek nie jest definiowany. Aby ją zakończyć musimy sami umieścić sprawdzenie odpowiedniego warunku bezpośrednio jako jedno z poleceń wewnątrz pętli, a także użyć instrukcji break, aby wyjść z pętli. W przeciwnym przypadku pętla będzie nieskończona.

x <- 0

repeat {
  print(x)
  x = x + 1
  if (x == 9) break
}
## [1] 0
## [1] 1
## [1] 2
## [1] 3
## [1] 4
## [1] 5
## [1] 6
## [1] 7
## [1] 8



Instrukcja for()


Pętla iteracyjna (pętla licznikowa) to rodzaj pętli, w ramach której następuje wykonanie określonej liczby iteracji (powtórzeń).


Podstawowa składnia: for(): for (zmienna in {zbiór wartosci}){ POLECENIA }

(wektor <- 11:20)
##  [1] 11 12 13 14 15 16 17 18 19 20
# przykład 1
for(i in 1:5){ # iterator (zmienna sterująca)
  print(wektor)
}
##  [1] 11 12 13 14 15 16 17 18 19 20
##  [1] 11 12 13 14 15 16 17 18 19 20
##  [1] 11 12 13 14 15 16 17 18 19 20
##  [1] 11 12 13 14 15 16 17 18 19 20
##  [1] 11 12 13 14 15 16 17 18 19 20
# przykład 2
for(i in 1:length(wektor)){
  print(wektor[i]) # dobieramy się do indeksów wektora
}
## [1] 11
## [1] 12
## [1] 13
## [1] 14
## [1] 15
## [1] 16
## [1] 17
## [1] 18
## [1] 19
## [1] 20


Drukowanie elementów wektora

vector <- c("Leroy", 
            "Slums Attack", 
            "Kaliber 44", 
            "Molesta", 
            "Taco Hemingway",
            "Thinkadelic",
            "O.S.T.R.", 
            "Tede", 
            "Łona i Webber")

for (variable in vector) {
  print(variable)
}
## [1] "Leroy"
## [1] "Slums Attack"
## [1] "Kaliber 44"
## [1] "Molesta"
## [1] "Taco Hemingway"
## [1] "Thinkadelic"
## [1] "O.S.T.R."
## [1] "Tede"
## [1] "Łona i Webber"


iteracja po wektorze

owoce <- c("jabłko", "banana", "gruszkę")

for (owoc in owoce) {
  print(paste("Lubię", owoc))
}
## [1] "Lubię jabłko"
## [1] "Lubię banana"
## [1] "Lubię gruszkę"


Suma elementów wektora

liczby <- c(2, 4, 6, 8)
suma <- 0

for (x in liczby) {
  suma <- suma + x
}

suma
## [1] 20



break i next -> do kontroli (zmiany) przepływu pętli.


Gdybyśmy kwestionowali “raperskość” np. Taco Hemingway’a, moglibyśmy zmodyfikować powyższy kod na dwa sposoby.
Tu pętlę przerywamy, gdy napotka na element (artystę) “Taco Hemingway”:

for (variable in vector) {
  if(variable == "Taco Hemingway"){
    break
  }
  print(variable)
}
## [1] "Leroy"
## [1] "Slums Attack"
## [1] "Kaliber 44"
## [1] "Molesta"


Bądź dyskretnie pomijamy artystę przy drukowaniu elementów do konsoli 

for (variable in vector) {
  if(variable == "Taco Hemingway"){
    next
  }
  print(variable)
}
## [1] "Leroy"
## [1] "Slums Attack"
## [1] "Kaliber 44"
## [1] "Molesta"
## [1] "Thinkadelic"
## [1] "O.S.T.R."
## [1] "Tede"
## [1] "Łona i Webber"


Możemy również wydrukować naszych hip-hop-raperów używając iteratora nieco inaczej. Zobaczmy

for (i in 1:length(vector)) {
  print(vector[i])
}
## [1] "Leroy"
## [1] "Slums Attack"
## [1] "Kaliber 44"
## [1] "Molesta"
## [1] "Taco Hemingway"
## [1] "Thinkadelic"
## [1] "O.S.T.R."
## [1] "Tede"
## [1] "Łona i Webber"


Dzięki takiemu zapisowi, który jest równoważny z poprzednim, mamy dostęp do dodatkowej informacji, tj. do numeru indeksu elementu wektora

for (i in 1:length(vector)) {
  print(paste0(vector[i], " to raper numer ", i))
}
## [1] "Leroy to raper numer 1"
## [1] "Slums Attack to raper numer 2"
## [1] "Kaliber 44 to raper numer 3"
## [1] "Molesta to raper numer 4"
## [1] "Taco Hemingway to raper numer 5"
## [1] "Thinkadelic to raper numer 6"
## [1] "O.S.T.R. to raper numer 7"
## [1] "Tede to raper numer 8"
## [1] "Łona i Webber to raper numer 9"



Tabliczka mnożenia (for() w forze())

for (i in 1:3) {
  for (j in 1:3) {
    cat(i, "*", j, "=", i * j, "\n")
  }
}
## 1 * 1 = 1 
## 1 * 2 = 2 
## 1 * 3 = 3 
## 2 * 1 = 2 
## 2 * 2 = 4 
## 2 * 3 = 6 
## 3 * 1 = 3 
## 3 * 2 = 6 
## 3 * 3 = 9


for() można używać na innych obiektach niż wektor oraz z powodzeniem zagnieżdżać. Przykład miksu instrukcji i pętli.

# pusta macierz
(macierz <- matrix(0, nrow = 10, ncol = 3))
##       [,1] [,2] [,3]
##  [1,]    0    0    0
##  [2,]    0    0    0
##  [3,]    0    0    0
##  [4,]    0    0    0
##  [5,]    0    0    0
##  [6,]    0    0    0
##  [7,]    0    0    0
##  [8,]    0    0    0
##  [9,]    0    0    0
## [10,]    0    0    0
# wypełnianie macierzy wartościami (np. wielokrotności "Trójki", 
# takie radio kiedyś było... :(

liczba <- 0

for(i in 1:nrow(macierz)){
  for(j in 1:ncol(macierz)){
    macierz[i, j] <- liczba
    liczba <- liczba + 3 # 
  }
}

macierz
##       [,1] [,2] [,3]
##  [1,]    0    3    6
##  [2,]    9   12   15
##  [3,]   18   21   24
##  [4,]   27   30   33
##  [5,]   36   39   42
##  [6,]   45   48   51
##  [7,]   54   57   60
##  [8,]   63   66   69
##  [9,]   72   75   78
## [10,]   81   84   87


if() wewnątrz pętli

for (i in 1:10) {
  if (i %% 2 == 0) {
    print(paste(i, "jest parzysta"))
  }
}
## [1] "2 jest parzysta"
## [1] "4 jest parzysta"
## [1] "6 jest parzysta"
## [1] "8 jest parzysta"
## [1] "10 jest parzysta"


for (litera in c("k", "O", "g", "n", "i", "T", "Y", "W", "i",  "s", "T", "A")) {
  if(litera == "k") litery = toupper(litera) else
    litery = paste0(litery, tolower(litera))
  print(litery)
}
## [1] "K"
## [1] "Ko"
## [1] "Kog"
## [1] "Kogn"
## [1] "Kogni"
## [1] "Kognit"
## [1] "Kognity"
## [1] "Kognityw"
## [1] "Kognitywi"
## [1] "Kognitywis"
## [1] "Kognitywist"
## [1] "Kognitywista"
# było łatwo bo słowo 'kognitywistyka' zawiera tylko jedno 'K'


Zapisywanie wyników do wektora

wyniki <- numeric(5) # co jest w środku?

for (i in 1:5) { # a 1:6
  wyniki[i] <- i^2
}

wyniki
## [1]  1  4  9 16 25


next i break w for()

for (i in 1:5) {
  if (i == 3) {
    next
  }
  if (i == 5) {
    break
  }
  print(i)
}
## [1] 1
## [1] 2
## [1] 4



Instrukcje warunkowe - podsumowanie

  • if/else - podstawowa kontrola przepływu

  • ifelse() - wektoryzowane warunki, szybkie dla dużych zbiorów

  • switch() - eleganckie przełączanie między opcjami

  • case_when() - nowoczesne, czytelne rozwiązanie dla złożonych warunków



Funkcje apply()

Funkcja Dane wejściowe Dane wyjściowe Zastosowanie
apply() Macierz/data.frame Wektor/macierz/lista Operacje na wierszach/kolumnach
lapply() Lista/wektor Lista Zachowanie struktury listy
sapply() Lista/wektor Wektor/macierz Uproszczony wynik
vapply() Lista/wektor Określony typ Bezpieczna wersja sapply
tapply() Wektor + grupy Tablica Agregacja według grup
mapply() Wiele list/wektorów Lista/wektor Funkcje wielo-argumentowe



apply()

Praca na matrycach

m <- matrix(1:9, nrow = 3)

apply(m, 1, mean)  # po wierszach
## [1] 4 5 6
apply(m, 2, sum)   # po kolumnach
## [1]  6 15 24

1 – wiersze

2 – kolumny


lapply()

Praca na listach

lista <- list(
  a = c(1, 2, 3),
  b = c(10, 20),
  c = c(5, 5, 5)
)

lapply(lista, mean)
## $a
## [1] 2
## 
## $b
## [1] 15
## 
## $c
## [1] 5


sapply(lista, mean) # ta funkcja próbuje uprościć wynik do wektora
##  a  b  c 
##  2 15  5

Warunki + apply()

x <- c(2, 5, 8, 1)

sapply(x, function(i) {
  if (i > 5) "duże" else "małe"
})
## [1] "małe" "małe" "duże" "małe"

Gdzie:

if() działa na pojedynczej wartości, natomiast apply() robi iterację.


Porównanie: ifelse() vs sapply(if())

ifelse(x > 5, "duże", "małe")
## [1] "małe" "małe" "duże" "małe"
# vs

sapply(x, function(i) {
  if (i > 5) "duże" else "małe"
})
## [1] "małe" "małe" "duże" "małe"

Zalety stosowania funkcji z rodziny apply()

  1. Czytelność - kod jest zwięzły i łatwy do zrozumienia

  2. Wydajność - często szybsze niż pętle for

  3. Funkcyjność - zgodne z paradygmatem programowania funkcyjnego w R

  4. Mniej błędów - brak konieczności zarządzania indeksami pętli




“https://www.uw.edu.pl/”
“https://www.uw.edu.pl/”


Źródła i inspiracje pomocne w przygotowaniu niniejszej prezentacji:

  • datacamp.com Intermediate R

  • datacamp.com Introduction to Writing Functions in R

  • Materiały z warsztatów Data Science w zastosowaniach biznesowych - Warsztaty z wykorzystaniem programu R Uniwersytet Warszawski, Wydział Nauk Ekonomicznych