Follow-up do zajęć dotyczących zajawek programistycznych (funkcji i instrukcji warunkowych).


R jest jednym z najpotężniejszych języków do analizy danych (jako się rzekło wielokrotnie w trakcie zajęć), a jego siła tkwi między innymi w możliwości łatwego przetwarzania dużych zbiorów danych za pomocą funkcji wyższego rzędu.
Rodzina funkcji apply() stanowi jedną z najczęściej wykorzystywanych grup narzędzi w tym zakresie. Umożliwiają one eleganckie i efektywne wykonywanie operacji na wierszach, kolumnach, listach, macierzach i innych strukturach danych, zastępując często bardziej rozwlekłe pętle.

apply()


W R alternatywą dla pętli for() jest zestaw funkcji z rodziny apply(). Są to funkcje dobrze zoptymalizowane, przez co szybkie, i jak się przekonamy, również oszczędne w pisaniu kodu. Rozpoznajmy je w boju…


Funkcja apply() wykonuje operacje na wierszach lub kolumnach matrycy bądź data.frame’u.

Postać ogólna: apply(X, MARGIN, FUN, ...)

  • X: macierz lub ramka danych.
  • MARGIN: 1 dla operacji na wierszach, 2 dla kolumn.
  • FUN: funkcja, którą chcemy zastosować.


(mat <- matrix(1:9, nrow = 3))
##      [,1] [,2] [,3]
## [1,]    1    4    7
## [2,]    2    5    8
## [3,]    3    6    9
apply(X = mat, MARGIN = 2, FUN = sum)  # Suma dla każdej kolumny
## [1]  6 15 24
apply(X = mat, MARGIN = 1, FUN = sum)  # Suma dla każdej wiersza
## [1] 12 15 18
apply(X = mat, MARGIN = 2, FUN = mean)  # średnia dla każdej kolumny
## [1] 2 5 8
apply(X = mat, MARGIN = 1, FUN = mean)  # średnia dla każdej wiersza
## [1] 4 5 6
str(mtcars) # data.frame, wszystkie zmienne są typu numeric
## 'data.frame':    32 obs. of  11 variables:
##  $ mpg : num  21 21 22.8 21.4 18.7 18.1 14.3 24.4 22.8 19.2 ...
##  $ cyl : num  6 6 4 6 8 6 8 4 4 6 ...
##  $ disp: num  160 160 108 258 360 ...
##  $ hp  : num  110 110 93 110 175 105 245 62 95 123 ...
##  $ drat: num  3.9 3.9 3.85 3.08 3.15 2.76 3.21 3.69 3.92 3.92 ...
##  $ wt  : num  2.62 2.88 2.32 3.21 3.44 ...
##  $ qsec: num  16.5 17 18.6 19.4 17 ...
##  $ vs  : num  0 0 1 1 0 1 0 1 1 1 ...
##  $ am  : num  1 1 1 0 0 0 0 0 0 0 ...
##  $ gear: num  4 4 4 3 3 3 3 4 4 4 ...
##  $ carb: num  4 4 1 1 2 1 4 2 2 4 ...
summary(mtcars)
##       mpg             cyl             disp             hp       
##  Min.   :10.40   Min.   :4.000   Min.   : 71.1   Min.   : 52.0  
##  1st Qu.:15.43   1st Qu.:4.000   1st Qu.:120.8   1st Qu.: 96.5  
##  Median :19.20   Median :6.000   Median :196.3   Median :123.0  
##  Mean   :20.09   Mean   :6.188   Mean   :230.7   Mean   :146.7  
##  3rd Qu.:22.80   3rd Qu.:8.000   3rd Qu.:326.0   3rd Qu.:180.0  
##  Max.   :33.90   Max.   :8.000   Max.   :472.0   Max.   :335.0  
##       drat             wt             qsec             vs        
##  Min.   :2.760   Min.   :1.513   Min.   :14.50   Min.   :0.0000  
##  1st Qu.:3.080   1st Qu.:2.581   1st Qu.:16.89   1st Qu.:0.0000  
##  Median :3.695   Median :3.325   Median :17.71   Median :0.0000  
##  Mean   :3.597   Mean   :3.217   Mean   :17.85   Mean   :0.4375  
##  3rd Qu.:3.920   3rd Qu.:3.610   3rd Qu.:18.90   3rd Qu.:1.0000  
##  Max.   :4.930   Max.   :5.424   Max.   :22.90   Max.   :1.0000  
##        am              gear            carb      
##  Min.   :0.0000   Min.   :3.000   Min.   :1.000  
##  1st Qu.:0.0000   1st Qu.:3.000   1st Qu.:2.000  
##  Median :0.0000   Median :4.000   Median :2.000  
##  Mean   :0.4062   Mean   :3.688   Mean   :2.812  
##  3rd Qu.:1.0000   3rd Qu.:4.000   3rd Qu.:4.000  
##  Max.   :1.0000   Max.   :5.000   Max.   :8.000
# vs
apply(mtcars, 2, summary)
##              mpg    cyl     disp       hp     drat      wt     qsec     vs
## Min.    10.40000 4.0000  71.1000  52.0000 2.760000 1.51300 14.50000 0.0000
## 1st Qu. 15.42500 4.0000 120.8250  96.5000 3.080000 2.58125 16.89250 0.0000
## Median  19.20000 6.0000 196.3000 123.0000 3.695000 3.32500 17.71000 0.0000
## Mean    20.09062 6.1875 230.7219 146.6875 3.596563 3.21725 17.84875 0.4375
## 3rd Qu. 22.80000 8.0000 326.0000 180.0000 3.920000 3.61000 18.90000 1.0000
## Max.    33.90000 8.0000 472.0000 335.0000 4.930000 5.42400 22.90000 1.0000
##              am   gear   carb
## Min.    0.00000 3.0000 1.0000
## 1st Qu. 0.00000 3.0000 2.0000
## Median  0.00000 4.0000 2.0000
## Mean    0.40625 3.6875 2.8125
## 3rd Qu. 1.00000 4.0000 4.0000
## Max.    1.00000 5.0000 8.0000
apply(mtcars, 2, sd)
##         mpg         cyl        disp          hp        drat          wt 
##   6.0269481   1.7859216 123.9386938  68.5628685   0.5346787   0.9784574 
##        qsec          vs          am        gear        carb 
##   1.7869432   0.5040161   0.4989909   0.7378041   1.6152000



lapply


?lapply


lapply {base} returns a list of the same length as X, each element of which is the result of applying FUN to the corresponding element of X.


Co więcej, “If FUN requires additional arguments, you pass them after you’ve specified X and FUN (…). The output of lapply() is a list, the same length as X, where each element is the result of applying FUN on the corresponding element of X”

…czyli Wykonuje funkcję na każdym elemencie listy/wektora, zwraca listę.


Postać ogólna: lapply(X, FUN, ...) 

# Długość każdego słowa
lapply(c("kot", "pies", "mysz"), nchar)
## [[1]]
## [1] 3
## 
## [[2]]
## [1] 4
## 
## [[3]]
## [1] 4


# Pierwiastek z liczb
lapply(1:3, sqrt)
## [[1]]
## [1] 1
## 
## [[2]]
## [1] 1.414214
## 
## [[3]]
## [1] 1.732051


(Polska <- list(Populacja = 37019327,
                Powierzchnia = 312696,
                Województwa = c("dolnośląskie","kujawsko-pomorskie","lubelskie","lubuskie",
                                "łódzkie","małopolskie","mazowieckie","opolskie","podkarpackie",
                                "podlaskie","pomorskie","śląskie","świętokrzyskie",
                                "warmińsko-mazurskie","wielkopolskie","zachodniopomorskie"),
                Stolica = "Warszawa"))
## $Populacja
## [1] 37019327
## 
## $Powierzchnia
## [1] 312696
## 
## $Województwa
##  [1] "dolnośląskie"        "kujawsko-pomorskie"  "lubelskie"          
##  [4] "lubuskie"            "łódzkie"             "małopolskie"        
##  [7] "mazowieckie"         "opolskie"            "podkarpackie"       
## [10] "podlaskie"           "pomorskie"           "śląskie"            
## [13] "świętokrzyskie"      "warmińsko-mazurskie" "wielkopolskie"      
## [16] "zachodniopomorskie" 
## 
## $Stolica
## [1] "Warszawa"


Chcąc, powiedzmy, poznać jakiego typu jest każdy element listy możemy użyć pętlifor()

for(info in Polska) { # iterator przechodzi po każdy elemencie listy Polska
  print(class(info))
}
## [1] "numeric"
## [1] "numeric"
## [1] "character"
## [1] "character"


Lub skorzystać z funkcji lapply()

lapply(X = Polska, # element, na którym ma zadziałać jakaś funkcja
       FUN = class # funkcja, której chcemy użyć
       ) 
## $Populacja
## [1] "numeric"
## 
## $Powierzchnia
## [1] "numeric"
## 
## $Województwa
## [1] "character"
## 
## $Stolica
## [1] "character"


Chcąc, na przykład, sprawdzić jak długie są nazwy naszych województw, możemy użyć funkcji for()

(liczba_znakow <- c()) # tworzymy pusty wektor, miejsce do trzymania wyników
## NULL
# puszczamy pętlę i iterujemy
for(i in 1:length(Polska$Województwa)) {
  liczba_znakow[i] <- nchar(Polska$Województwa[i])
}
# wynik
liczba_znakow
##  [1] 12 18  9  8  7 11 11  8 12  9  9  7 14 19 13 18


bądź zastosować funkcję lapply()

lapply(Polska$Województwa, nchar) # zwróci listę, proszę zwrócić uwagę na prostotę składni
## [[1]]
## [1] 12
## 
## [[2]]
## [1] 18
## 
## [[3]]
## [1] 9
## 
## [[4]]
## [1] 8
## 
## [[5]]
## [1] 7
## 
## [[6]]
## [1] 11
## 
## [[7]]
## [1] 11
## 
## [[8]]
## [1] 8
## 
## [[9]]
## [1] 12
## 
## [[10]]
## [1] 9
## 
## [[11]]
## [1] 9
## 
## [[12]]
## [1] 7
## 
## [[13]]
## [1] 14
## 
## [[14]]
## [1] 19
## 
## [[15]]
## [1] 13
## 
## [[16]]
## [1] 18
# chcąc otrzymać wektor, należy zapakować ją dodatkowo w funkcję unlist()
unlist(lapply(Polska$Województwa, nchar))
##  [1] 12 18  9  8  7 11 11  8 12  9  9  7 14 19 13 18


Ważnym elementem naszego rozwoju programistycznego, było poznanie możliwości pisania własnych funkcji.
lapply() pozwala na stosowanie ich jako swojego argumentu. Przypuśćmy, że mamy wektor z cenami komiksów z Amazon’a i chcemy wykorzystać własną funkcję do przeliczania walut, bo nam się powiedzmy łatwiej myśli o wydatkach w walucie narodowej. Nic prostszego, spójrzmy.
Ceny naszych komiksów

ceny_komiksow_Euro <- c(7.8, 9.6, 13, 11.3, 9.96)


Mamy własną funkcję do zamiany złotówek na inne waluty

przelicz <- function(wektor, kurs){
  wynik = wektor * kurs
  return(wynik)}


Zatem liczymy

# oczywiście, że w tym przypadku można zarówno zrobić tak (najprościej)
(ceny_komiksow_PL <- ceny_komiksow_Euro * 4.65)
## [1] 36.270 44.640 60.450 52.545 46.314
# bądź tak (lepiej, elastyczniej, z użyciem własnej funkcji)
(ceny_komiksow_PL <- przelicz(wektor = ceny_komiksow_Euro, kurs = 4.65))
## [1] 36.270 44.640 60.450 52.545 46.314
# ale dla celów szkoleniowych użyjmy lapply()
(ceny_komiksow_PL <- unlist(lapply(ceny_komiksow_Euro, przelicz, kurs = 4.65)))
## [1] 36.270 44.640 60.450 52.545 46.314


Inny przykład użycia własnej funkcji. Przygotowujemy projekt o naszych ulubionych postaciach z najdłuższej polskiej telenoweli pt. “Klan”.

# wspominkowo:
# https://www.msn.com/pl-pl/wiadomosci/other/serial-straci%C5%82-wielu-wspania%C5%82ych-aktor%C3%B3w-z-nimi-musieli%C5%9Bmy-si%C4%99-po%C5%BCegna%C4%87/ar-AA16iU9F?ocid=entnewsntp&cvid=82d53a252ed64a139a61f31abb79611e
(KLAN_bohaterowie <- c("Ryszard.Lubicz", 
                       "Bożena.Kazuń", 
                       "agnieszka.lubicz", 
                       "Dominika.Torman", 
                       "feliks.nowak",
                       "Leopold.Kwapisz",
                       "Monika.Nawrot")
 )
## [1] "Ryszard.Lubicz"   "Bożena.Kazuń"     "agnieszka.lubicz" "Dominika.Torman" 
## [5] "feliks.nowak"     "Leopold.Kwapisz"  "Monika.Nawrot"


Wyciągamy ze sklejonego string’a imię i nazwisko.

(KLAN_bohaterowie <- strsplit(x = KLAN_bohaterowie, split = ".", fixed = T))
## [[1]]
## [1] "Ryszard" "Lubicz" 
## 
## [[2]]
## [1] "Bożena" "Kazuń" 
## 
## [[3]]
## [1] "agnieszka" "lubicz"   
## 
## [[4]]
## [1] "Dominika" "Torman"  
## 
## [[5]]
## [1] "feliks" "nowak" 
## 
## [[6]]
## [1] "Leopold" "Kwapisz"
## 
## [[7]]
## [1] "Monika" "Nawrot"


Powiększamy literki (żeby pozbyć się tej niekonsekwencji w używaniu wielkich liter).

(KLAN_bohaterowie <- lapply(KLAN_bohaterowie, toupper))
## [[1]]
## [1] "RYSZARD" "LUBICZ" 
## 
## [[2]]
## [1] "BOŻENA" "KAZUŃ" 
## 
## [[3]]
## [1] "AGNIESZKA" "LUBICZ"   
## 
## [[4]]
## [1] "DOMINIKA" "TORMAN"  
## 
## [[5]]
## [1] "FELIKS" "NOWAK" 
## 
## [[6]]
## [1] "LEOPOLD" "KWAPISZ"
## 
## [[7]]
## [1] "MONIKA" "NAWROT"


Piszemy albo funkcję do wyciągania elementu z listy i stosujemy na danych osobowych bohaterów

wybierz_imie <- function(i) {
  i[1]
  }

wybierz_nazwisko <- function(n) {
  n[2]
  }

(imie <- unlist(lapply(KLAN_bohaterowie, wybierz_imie)))
## [1] "RYSZARD"   "BOŻENA"    "AGNIESZKA" "DOMINIKA"  "FELIKS"    "LEOPOLD"  
## [7] "MONIKA"
(nazwisko <- unlist(lapply(KLAN_bohaterowie, wybierz_nazwisko)))
## [1] "LUBICZ"  "KAZUŃ"   "LUBICZ"  "TORMAN"  "NOWAK"   "KWAPISZ" "NAWROT"


Albo używamy funkcji anonimowych (równoważne z powyższym)

(imie <- unlist(lapply(KLAN_bohaterowie, function(i){i[1]})))
## [1] "RYSZARD"   "BOŻENA"    "AGNIESZKA" "DOMINIKA"  "FELIKS"    "LEOPOLD"  
## [7] "MONIKA"
(nazwisko <- unlist(lapply(KLAN_bohaterowie, function(n){n[2]})))
## [1] "LUBICZ"  "KAZUŃ"   "LUBICZ"  "TORMAN"  "NOWAK"   "KWAPISZ" "NAWROT"


Albo przepisać poprzednie funkcje na jedną, bardziej ogólną

wybierz <- function(i_n, indeks) {
  i_n[indeks]
}

(imie <- unlist(lapply(KLAN_bohaterowie, wybierz, indeks=1)))
## [1] "RYSZARD"   "BOŻENA"    "AGNIESZKA" "DOMINIKA"  "FELIKS"    "LEOPOLD"  
## [7] "MONIKA"
(nazwisko <- unlist(lapply(KLAN_bohaterowie, wybierz, indeks=2)))
## [1] "LUBICZ"  "KAZUŃ"   "LUBICZ"  "TORMAN"  "NOWAK"   "KWAPISZ" "NAWROT"


sapply


?sapply

sapply {base} is a user-friendly version and wrapper of lapply by default returning a vector, matrix.

…czyli upraszcza wynik do wektora lub macierzy.

S jak simplify 


# Teraz dostaniemy wektor
sapply(c("kot", "pies", "mysz"), nchar)
##  kot pies mysz 
##    3    4    4


# Kwadraty liczb
sapply(1:5, function(x) x^2) # <- funkcja anonimowa
## [1]  1  4  9 16 25


sapply(X = Polska$Województwa, # element, na którym ma zadziałać jakaś funkcja
       FUN = nchar # funkcja, której chcemy użyć
       ) 
##        dolnośląskie  kujawsko-pomorskie           lubelskie            lubuskie 
##                  12                  18                   9                   8 
##             łódzkie         małopolskie         mazowieckie            opolskie 
##                   7                  11                  11                   8 
##        podkarpackie           podlaskie           pomorskie             śląskie 
##                  12                   9                   9                   7 
##      świętokrzyskie warmińsko-mazurskie       wielkopolskie  zachodniopomorskie 
##                  14                  19                  13                  18
# lub 
sapply(X = Polska$Województwa, # element, na którym ma zadziałać jakaś funkcja
       FUN = nchar, # funkcja, której chcemy użyć
       USE.NAMES = FALSE # jeśli nie chcemy, żeby nasz wektor został nazwany
       ) 
##  [1] 12 18  9  8  7 11 11  8 12  9  9  7 14 19 13 18


Czasem jednak, z uwagi na różne długości output’u, nie da się skonwertować obiektu do postaci wektora lub macierzy. Co wówczas?

(imie <- sapply(Polska$Województwa, strsplit, split=''))
## $dolnośląskie
##  [1] "d" "o" "l" "n" "o" "ś" "l" "ą" "s" "k" "i" "e"
## 
## $`kujawsko-pomorskie`
##  [1] "k" "u" "j" "a" "w" "s" "k" "o" "-" "p" "o" "m" "o" "r" "s" "k" "i" "e"
## 
## $lubelskie
## [1] "l" "u" "b" "e" "l" "s" "k" "i" "e"
## 
## $lubuskie
## [1] "l" "u" "b" "u" "s" "k" "i" "e"
## 
## $łódzkie
## [1] "ł" "ó" "d" "z" "k" "i" "e"
## 
## $małopolskie
##  [1] "m" "a" "ł" "o" "p" "o" "l" "s" "k" "i" "e"
## 
## $mazowieckie
##  [1] "m" "a" "z" "o" "w" "i" "e" "c" "k" "i" "e"
## 
## $opolskie
## [1] "o" "p" "o" "l" "s" "k" "i" "e"
## 
## $podkarpackie
##  [1] "p" "o" "d" "k" "a" "r" "p" "a" "c" "k" "i" "e"
## 
## $podlaskie
## [1] "p" "o" "d" "l" "a" "s" "k" "i" "e"
## 
## $pomorskie
## [1] "p" "o" "m" "o" "r" "s" "k" "i" "e"
## 
## $śląskie
## [1] "ś" "l" "ą" "s" "k" "i" "e"
## 
## $świętokrzyskie
##  [1] "ś" "w" "i" "ę" "t" "o" "k" "r" "z" "y" "s" "k" "i" "e"
## 
## $`warmińsko-mazurskie`
##  [1] "w" "a" "r" "m" "i" "ń" "s" "k" "o" "-" "m" "a" "z" "u" "r" "s" "k" "i" "e"
## 
## $wielkopolskie
##  [1] "w" "i" "e" "l" "k" "o" "p" "o" "l" "s" "k" "i" "e"
## 
## $zachodniopomorskie
##  [1] "z" "a" "c" "h" "o" "d" "n" "i" "o" "p" "o" "m" "o" "r" "s" "k" "i" "e"
# versus
(imie <- lapply(Polska$Województwa, strsplit, split=''))
## [[1]]
## [[1]][[1]]
##  [1] "d" "o" "l" "n" "o" "ś" "l" "ą" "s" "k" "i" "e"
## 
## 
## [[2]]
## [[2]][[1]]
##  [1] "k" "u" "j" "a" "w" "s" "k" "o" "-" "p" "o" "m" "o" "r" "s" "k" "i" "e"
## 
## 
## [[3]]
## [[3]][[1]]
## [1] "l" "u" "b" "e" "l" "s" "k" "i" "e"
## 
## 
## [[4]]
## [[4]][[1]]
## [1] "l" "u" "b" "u" "s" "k" "i" "e"
## 
## 
## [[5]]
## [[5]][[1]]
## [1] "ł" "ó" "d" "z" "k" "i" "e"
## 
## 
## [[6]]
## [[6]][[1]]
##  [1] "m" "a" "ł" "o" "p" "o" "l" "s" "k" "i" "e"
## 
## 
## [[7]]
## [[7]][[1]]
##  [1] "m" "a" "z" "o" "w" "i" "e" "c" "k" "i" "e"
## 
## 
## [[8]]
## [[8]][[1]]
## [1] "o" "p" "o" "l" "s" "k" "i" "e"
## 
## 
## [[9]]
## [[9]][[1]]
##  [1] "p" "o" "d" "k" "a" "r" "p" "a" "c" "k" "i" "e"
## 
## 
## [[10]]
## [[10]][[1]]
## [1] "p" "o" "d" "l" "a" "s" "k" "i" "e"
## 
## 
## [[11]]
## [[11]][[1]]
## [1] "p" "o" "m" "o" "r" "s" "k" "i" "e"
## 
## 
## [[12]]
## [[12]][[1]]
## [1] "ś" "l" "ą" "s" "k" "i" "e"
## 
## 
## [[13]]
## [[13]][[1]]
##  [1] "ś" "w" "i" "ę" "t" "o" "k" "r" "z" "y" "s" "k" "i" "e"
## 
## 
## [[14]]
## [[14]][[1]]
##  [1] "w" "a" "r" "m" "i" "ń" "s" "k" "o" "-" "m" "a" "z" "u" "r" "s" "k" "i" "e"
## 
## 
## [[15]]
## [[15]][[1]]
##  [1] "w" "i" "e" "l" "k" "o" "p" "o" "l" "s" "k" "i" "e"
## 
## 
## [[16]]
## [[16]][[1]]
##  [1] "z" "a" "c" "h" "o" "d" "n" "i" "o" "p" "o" "m" "o" "r" "s" "k" "i" "e"


Zobaczmy kilka przykładów użyć funkcji sapply i lapply na przykładzie listy zawierającej pomiar temperatury z siedmiu dni

(temperatura <- list(c(3,7,9,6,-1), 
                    c(6, 9,12,13,5),
                    c(4,8,3,-1,-3),
                    c(1,4,7,2,-2),
                    c(5,7,9,4,2),
                    c(-3,5,8,9,4),
                    c(3,6,9,4,1)))
## [[1]]
## [1]  3  7  9  6 -1
## 
## [[2]]
## [1]  6  9 12 13  5
## 
## [[3]]
## [1]  4  8  3 -1 -3
## 
## [[4]]
## [1]  1  4  7  2 -2
## 
## [[5]]
## [1] 5 7 9 4 2
## 
## [[6]]
## [1] -3  5  8  9  4
## 
## [[7]]
## [1] 3 6 9 4 1


Temperatura minimalna w każdy z inwestygowanych dni:

lapply(temperatura, min)
## [[1]]
## [1] -1
## 
## [[2]]
## [1] 5
## 
## [[3]]
## [1] -3
## 
## [[4]]
## [1] -2
## 
## [[5]]
## [1] 2
## 
## [[6]]
## [1] -3
## 
## [[7]]
## [1] 1
# versus
sapply(temperatura, min)
## [1] -1  5 -3 -2  2 -3  1


Temperatura maksymalna

lapply(temperatura, max)
## [[1]]
## [1] 9
## 
## [[2]]
## [1] 13
## 
## [[3]]
## [1] 8
## 
## [[4]]
## [1] 7
## 
## [[5]]
## [1] 9
## 
## [[6]]
## [1] 9
## 
## [[7]]
## [1] 9
# versus
sapply(temperatura, max)
## [1]  9 13  8  7  9  9  9


Funkcja sapply, podobnie jak lapply umożliwia stosowanie własnych funkcji. Napiszmy szybko taką, która bada średnią z ekstremów temperatury danego dnia

extremes_avg <- function(x) {
  (min(x) + max(x)) / 2
  }

lapply(temperatura, extremes_avg)
## [[1]]
## [1] 4
## 
## [[2]]
## [1] 9
## 
## [[3]]
## [1] 2.5
## 
## [[4]]
## [1] 2.5
## 
## [[5]]
## [1] 5.5
## 
## [[6]]
## [1] 3
## 
## [[7]]
## [1] 5
# versus
sapply(temperatura, extremes_avg)
## [1] 4.0 9.0 2.5 2.5 5.5 3.0 5.0


Zwróćmy temperatury minimalną i maksymalną (w jednym wektorze) z danego dnia. Króciutka funkcja.

extremes <- function(x) {
  c(min = min(x), max = max(x))
}

lapply(temperatura, extremes)
## [[1]]
## min max 
##  -1   9 
## 
## [[2]]
## min max 
##   5  13 
## 
## [[3]]
## min max 
##  -3   8 
## 
## [[4]]
## min max 
##  -2   7 
## 
## [[5]]
## min max 
##   2   9 
## 
## [[6]]
## min max 
##  -3   9 
## 
## [[7]]
## min max 
##   1   9
# versus
sapply(temperatura, extremes)
##     [,1] [,2] [,3] [,4] [,5] [,6] [,7]
## min   -1    5   -3   -2    2   -3    1
## max    9   13    8    7    9    9    9


Niestety są sytuacje w danych, gdzie funkcja sapply nie da rady z różnych względów “uprościć” nam output’u

below_zero <- function(x) {
  return(x[x < 0])
  }

sapply(temperatura, below_zero)
## [[1]]
## [1] -1
## 
## [[2]]
## numeric(0)
## 
## [[3]]
## [1] -1 -3
## 
## [[4]]
## [1] -2
## 
## [[5]]
## numeric(0)
## 
## [[6]]
## [1] -3
## 
## [[7]]
## numeric(0)
# sapply, de facto wrapper funkcji lapply, poszedł po starszego brata
identical(sapply(temperatura, below_zero), 
          lapply(temperatura, below_zero))
## [1] TRUE


print_info <- function(x) {
  cat("średnia temperatura wynosi ", mean(x), "\n")
  }

sapply(temperatura, print_info)
## średnia temperatura wynosi  4.8 
## średnia temperatura wynosi  9 
## średnia temperatura wynosi  2.2 
## średnia temperatura wynosi  2.4 
## średnia temperatura wynosi  5.4 
## średnia temperatura wynosi  4.6 
## średnia temperatura wynosi  4.6
## [[1]]
## NULL
## 
## [[2]]
## NULL
## 
## [[3]]
## NULL
## 
## [[4]]
## NULL
## 
## [[5]]
## NULL
## 
## [[6]]
## NULL
## 
## [[7]]
## NULL
identical(sapply(temperatura, print_info),
          lapply(temperatura, print_info))
## średnia temperatura wynosi  4.8 
## średnia temperatura wynosi  9 
## średnia temperatura wynosi  2.2 
## średnia temperatura wynosi  2.4 
## średnia temperatura wynosi  5.4 
## średnia temperatura wynosi  4.6 
## średnia temperatura wynosi  4.6 
## średnia temperatura wynosi  4.8 
## średnia temperatura wynosi  9 
## średnia temperatura wynosi  2.2 
## średnia temperatura wynosi  2.4 
## średnia temperatura wynosi  5.4 
## średnia temperatura wynosi  4.6 
## średnia temperatura wynosi  4.6
## [1] TRUE



vapply


?vapply

vapply {base} is similar to sapply, but has a pre-specified type of return value, so it can be safer (and sometimes faster) to use.

Czyli jak sapply(), ale bezpieczniejsze - musisz z góry określić typ i długość wyniku.

Składnia: vapply(dane, funkcja, FUN.VALUE)

FUN.VALUE = wzorzec wyniku (np.numeric(1) dla jednej liczby)

Po co? Jeśli wynik będzie inny niż oczekiwany, dostaniesz błąd zamiast niespodzianki.


# Długość słów - spodziewamy się jednej liczby
vapply(c("kot", "pies"), nchar, numeric(1))
##  kot pies 
##    3    4


# Pierwsze 3 litery - spodziewamy się 3 znaków
lista <- list(c("a","b","c","d"), c("x","y","z"))
vapply(lista, function(x) x[1:3], character(3))
##      [,1] [,2]
## [1,] "a"  "x" 
## [2,] "b"  "y" 
## [3,] "c"  "z"


vapply(X = Polska$Województwa, # element, na którym ma zadziałać jakaś funkcja
       FUN = nchar, # funkcja, której chcemy użyć
       numeric(1), # prosimy funkcję (tu nchar()), żeby zwróciła pojedynczą wartość numeryczną
       USE.NAMES = FALSE # jeśli nie chcemy, żeby nasz wektor został nazwany
       ) 
##  [1] 12 18  9  8  7 11 11  8 12  9  9  7 14 19 13 18


basics <- function(x) {
  c(min = min(x), mean = mean(x), median = median(x), max = max(x))
  }

vapply(temperatura,
       basics,
       numeric(4) # bo po naszej funkcji spodziewamy się 4 wartości numerycznych
       )
##        [,1] [,2] [,3] [,4] [,5] [,6] [,7]
## min    -1.0    5 -3.0 -2.0  2.0 -3.0  1.0
## mean    4.8    9  2.2  2.4  5.4  4.6  4.6
## median  6.0    9  3.0  2.0  5.0  5.0  4.0
## max     9.0   13  8.0  7.0  9.0  9.0  9.0



tapply


Postać ogólna: tapply() pozwala na grupowanie danych według określonych kategorii i stosowanie funkcji do każdej grupy.

Składnia:

tapply(X, INDEX, FUN, ...)

  • X: wektor danych.
  • INDEX: wektor lub lista grup.
  • FUN: funkcja do zastosowania.
# Suma według grup
values <- c(10, 20, 30, 40, 50)
groups <- c("A", "A", "B", "B", "B")
tapply(values, groups, sum)
##   A   B 
##  30 120


# Średnia według grup
wiek <- c(25, 30, 22, 35, 28, 40)
plec <- c("M", "K", "M", "K", "M", "K")
tapply(wiek, plec, mean)
##  K  M 
## 35 25



apply() w przykładach

# Tworzymy ramkę danych
(df <- data.frame(
  ID = 1:5,
  Age = c(25, 30, 35, 40, 45),
  Salary = c(50000, 55000, 60000, 65000, 70000),
  Bonus = c(5000, 6000, 7000, 8000, 9000)
  )
 )
##   ID Age Salary Bonus
## 1  1  25  50000  5000
## 2  2  30  55000  6000
## 3  3  35  60000  7000
## 4  4  40  65000  8000
## 5  5  45  70000  9000

apply() –> operacje wierszami lub kolumnami.

Obliczmy całkowitą wypłatę ( Salary + Bonus) dla każdego wiersza.

# Dodajemy Salary i Bonus w każdym wierszu
df$Total <- apply(df[, c("Salary", "Bonus")], 1, sum)
df
##   ID Age Salary Bonus Total
## 1  1  25  50000  5000 55000
## 2  2  30  55000  6000 61000
## 3  3  35  60000  7000 67000
## 4  4  40  65000  8000 73000
## 5  5  45  70000  9000 79000

Obliczmy średnią dla każdej kolumny liczbowej.

# Obliczamy średnią dla kolumn Age, Salary, Bonus
apply(df[, c("Age", "Salary", "Bonus")], 2, mean)
##    Age Salary  Bonus 
##     35  60000   7000

lapply() –> stosowanie funkcji do każdej kolumny.

Sprawdźmy, czy wartości w każdej kolumnie są większe niż średnia w tej kolumnie.

# Porównanie każdej wartości do średniej kolumny
lapply(df[, c("Age", "Salary", "Bonus")], function(x) x > mean(x))
## $Age
## [1] FALSE FALSE FALSE  TRUE  TRUE
## 
## $Salary
## [1] FALSE FALSE FALSE  TRUE  TRUE
## 
## $Bonus
## [1] FALSE FALSE FALSE  TRUE  TRUE

sapply()–> zwrócenie wyników w wektorze lub macierzy, czyli lapply() w bardziej kompaktowej formie.

Obliczmy medianę każdej kolumny.

sapply(df[, c("Age", "Salary", "Bonus")], median)
##    Age Salary  Bonus 
##     35  60000   7000

tapply() –> grupowanie i obliczenia.

Dodamy do naszej ramki kolumnę Group, reprezentującą różne kategorie.

df$Group <- c("A", "A", "B", "B", "B")

Obliczmy średnią wypłatę ( Salary ) w grupach.

tapply(df$Salary, df$Group, mean)
##     A     B 
## 52500 65000

Obliczmy liczbę osób w każdej grupie.

tapply(df$ID, df$Group, length)
## A B 
## 2 3



mapply()


mapply() –> zastosowanie funkcji do wielu kolumn jednocześnie


# Dodawanie par liczb
mapply(sum, c(1,2,3), c(10,20,30))
## [1] 11 22 33


# Powtarzanie słów
mapply(rep, c("A","B","C"), c(2,3,1))
## $A
## [1] "A" "A"
## 
## $B
## [1] "B" "B" "B"
## 
## $C
## [1] "C"


Obliczmy różnicę między Salary i Bonus dla każdego wiersza.

mapply(function(s, b) s - b, df$Salary, df$Bonus)
## [1] 45000 49000 53000 57000 61000

Obliczmy łączną wartość Salary i Bonus dla każdej grupy ( Group ) za pomocą tapply().

tapply(df$Salary + df$Bonus, df$Group, sum)
##      A      B 
## 116000 219000

Znajdźmy maksymalny wiek ( Age ) dla każdej grupy za pomocą tapply().

tapply(df$Age, df$Group, max)
##  A  B 
## 30 45


Podsumowanie:

apply() → macierze (wiersze/kolumny) lapply() → lista → lista sapply() → lista → wektor tapply() → grupowanie mapply() → wiele argumentów naraz





Łączenie danych


“DataCamp.com”
“DataCamp.com”


Kilka przykładów kodu… 

slownik <- readxl::read_excel(path = "dane/joiningTables.xlsx", sheet = 1)
dane1  <- readxl::read_excel(path = "dane/joiningTables.xlsx", sheet = 2)
dane2  <- readxl::read_excel(path = "dane/joiningTables.xlsx", sheet = 3)


library(kableExtra)
slownik %>%
  kbl() %>%
  kable_styling()
ID Name
A AAA
B BBB
C CCC
D DDD
E EEE
F FFF 
dane1 %>%
  kbl() %>%
  kable_styling()
ID Rok Wskaznik1
A 2019 23
B 2019 34
C 2019 12
D 2019 78
A 2020 45
B 2020 56
C 2020 21
D 2020 98 
dane2 %>%
  kbl() %>%
  kable_styling()
ID Rok Wskaznik2
A 2019 2.555556
A 2020 5.000000
B 2019 3.777778
B 2020 6.222222
C 2019 1.333333
C 2020 2.333333
D 2019 8.666667
D 2020 10.888889
E 2019 12.675000
E 2020 13.476500
F 2019 56.234000
F 2020 678.453450

{dplyr}



inner_join()

“Cześć wspólna”

inner_join(x = dane1, y = slownik, by = c("ID" = "ID"))
## # A tibble: 8 × 4
##   ID      Rok Wskaznik1 Name 
##   <chr> <dbl>     <dbl> <chr>
## 1 A      2019        23 AAA  
## 2 B      2019        34 BBB  
## 3 C      2019        12 CCC  
## 4 D      2019        78 DDD  
## 5 A      2020        45 AAA  
## 6 B      2020        56 BBB  
## 7 C      2020        21 CCC  
## 8 D      2020        98 DDD



left_join()

“Lewa strona”

left_join(x = dane1, y = slownik, by = c("ID" = "ID"))
## # A tibble: 8 × 4
##   ID      Rok Wskaznik1 Name 
##   <chr> <dbl>     <dbl> <chr>
## 1 A      2019        23 AAA  
## 2 B      2019        34 BBB  
## 3 C      2019        12 CCC  
## 4 D      2019        78 DDD  
## 5 A      2020        45 AAA  
## 6 B      2020        56 BBB  
## 7 C      2020        21 CCC  
## 8 D      2020        98 DDD



right_join()

“Prawa strona”

right_join(x = dane1, y = slownik, by = c("ID" = "ID"))
## # A tibble: 10 × 4
##    ID      Rok Wskaznik1 Name 
##    <chr> <dbl>     <dbl> <chr>
##  1 A      2019        23 AAA  
##  2 B      2019        34 BBB  
##  3 C      2019        12 CCC  
##  4 D      2019        78 DDD  
##  5 A      2020        45 AAA  
##  6 B      2020        56 BBB  
##  7 C      2020        21 CCC  
##  8 D      2020        98 DDD  
##  9 E        NA        NA EEE  
## 10 F        NA        NA FFF



full_join()

“Wszystko ze wszystkim”

full_join(x = dane1, y = slownik, by = c("ID" = "ID"))
## # A tibble: 10 × 4
##    ID      Rok Wskaznik1 Name 
##    <chr> <dbl>     <dbl> <chr>
##  1 A      2019        23 AAA  
##  2 B      2019        34 BBB  
##  3 C      2019        12 CCC  
##  4 D      2019        78 DDD  
##  5 A      2020        45 AAA  
##  6 B      2020        56 BBB  
##  7 C      2020        21 CCC  
##  8 D      2020        98 DDD  
##  9 E        NA        NA EEE  
## 10 F        NA        NA FFF
# W przypadku braku unikalnego klucza
full_join(x = dane1, 
          y = dane2, 
          by = c("ID" = "ID", "Rok" = "Rok"))
## # A tibble: 12 × 4
##    ID      Rok Wskaznik1 Wskaznik2
##    <chr> <dbl>     <dbl>     <dbl>
##  1 A      2019        23      2.56
##  2 B      2019        34      3.78
##  3 C      2019        12      1.33
##  4 D      2019        78      8.67
##  5 A      2020        45      5   
##  6 B      2020        56      6.22
##  7 C      2020        21      2.33
##  8 D      2020        98     10.9 
##  9 E      2019        NA     12.7 
## 10 E      2020        NA     13.5 
## 11 F      2019        NA     56.2 
## 12 F      2020        NA    678.



semi_join() & anti_join()

Służą w zasadzie do filtrowania jednego zbioru drugim.

semi_join(x = slownik, 
          y = dane1, 
          by = c("ID" = "ID")) # Sprawdzam, które id występują w zbiorze dane1 i filtruję
## # A tibble: 4 × 2
##   ID    Name 
##   <chr> <chr>
## 1 A     AAA  
## 2 B     BBB  
## 3 C     CCC  
## 4 D     DDD
anti_join(x = slownik, 
          y = dane1, 
          by = c("ID" = "ID")) # sprawdzam, które id nie występują w zbiorze dane1 i filtruję
## # A tibble: 2 × 2
##   ID    Name 
##   <chr> <chr>
## 1 E     EEE  
## 2 F     FFF



{data.table}


A za pomocą {data.table}? Da się jednym poleceniem, wypełniając odpowiednią różne atrybuty funkcji.


Składnia merge(x, y, by = NULL, by.x = NULL, by.y = NULL, all = FALSE, all.x = all, all.y = all, ...)



Ekwiwalent inner_join() “Cześć wspólna”

merge(x = dane1, y = slownik, by = "ID", all = F)
##   ID  Rok Wskaznik1 Name
## 1  A 2019        23  AAA
## 2  A 2020        45  AAA
## 3  B 2019        34  BBB
## 4  B 2020        56  BBB
## 5  C 2019        12  CCC
## 6  C 2020        21  CCC
## 7  D 2019        78  DDD
## 8  D 2020        98  DDD



Ekwiwalent full_join()

“Wszystko ze wszystkim”

merge(x = dane1, y = slownik, by = "ID", all = T)
##    ID  Rok Wskaznik1 Name
## 1   A 2019        23  AAA
## 2   A 2020        45  AAA
## 3   B 2019        34  BBB
## 4   B 2020        56  BBB
## 5   C 2019        12  CCC
## 6   C 2020        21  CCC
## 7   D 2019        78  DDD
## 8   D 2020        98  DDD
## 9   E   NA        NA  EEE
## 10  F   NA        NA  FFF



Ekwiwalentleft_join() “Lewa strona”

merge(x = dane1, y = slownik, by = "ID", all.x = T)
##   ID  Rok Wskaznik1 Name
## 1  A 2019        23  AAA
## 2  A 2020        45  AAA
## 3  B 2019        34  BBB
## 4  B 2020        56  BBB
## 5  C 2019        12  CCC
## 6  C 2020        21  CCC
## 7  D 2019        78  DDD
## 8  D 2020        98  DDD



Ekwiwalent right_join() “Prawa strona”

merge(x = dane1, y = slownik, by = "ID", all.y = T)
##    ID  Rok Wskaznik1 Name
## 1   A 2019        23  AAA
## 2   A 2020        45  AAA
## 3   B 2019        34  BBB
## 4   B 2020        56  BBB
## 5   C 2019        12  CCC
## 6   C 2020        21  CCC
## 7   D 2019        78  DDD
## 8   D 2020        98  DDD
## 9   E   NA        NA  EEE
## 10  F   NA        NA  FFF



Case-study


Proszę zwrócić uwagę ile niekiedy zabiegów musimy poczynić, żeby móc połączyć dwa zbiory.

Mamy pozyskane z jakiegoś źródła, bądź stworzone samodzielnie dwa zbiory.

# słownik
woj_slownik <- read.csv(file = "dane/woj_slownik.csv")
dplyr::glimpse(woj_slownik)
## Rows: 17
## Columns: 2
## $ lp    <int> 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16
## $ Nazwa <chr> "POLSKA", "DOLNO?L?SKIE", "KUJAWSKO-POMORSKIE", "LUBELSKIE", "LU…
# dane
bezrobocie <- read_excel(path = "dane/RYNE_3965_XTAB_20230116093555.xlsx", 
                                 sheet = 2, 
                                 skip = 3)
dplyr::glimpse(bezrobocie)
## Rows: 17
## Columns: 25
## $ ...1           <chr> "0000000", "0200000", "0400000", "0600000", "0800000", …
## $ `[osoba]...2`  <dbl> 968888, 62842, 72655, 74449, 22201, 66036, 71489, 13654…
## $ `[osoba]...3`  <dbl> 866374, 56022, 64060, 69379, 18498, 58722, 62610, 12320…
## $ `[osoba]...4`  <dbl> 1046432, 68822, 73482, 76505, 23674, 67812, 83050, 1463…
## $ `[osoba]...5`  <dbl> 895203, 58738, 61861, 66244, 18158, 60902, 69948, 12924…
## $ `[osoba]...6`  <dbl> 426246, 27909, 28440, 35817, 9086, 30816, 30332, 65440,…
## $ `[osoba]...7`  <dbl> 386959, 25287, 25490, 33339, 7605, 27568, 27078, 59684,…
## $ `[osoba]...8`  <dbl> 484826, 32130, 30593, 37795, 10274, 33180, 37858, 72353…
## $ `[osoba]...9`  <dbl> 413268, 27631, 25273, 32916, 7834, 30288, 31879, 63966,…
## $ `[osoba]...10` <dbl> 542642, 34933, 44215, 38632, 13115, 35220, 41157, 71105…
## $ `[osoba]...11` <dbl> 479415, 30735, 38570, 36040, 10893, 31154, 35532, 63524…
## $ `[osoba]...12` <dbl> 561606, 36692, 42889, 38710, 13400, 34632, 45192, 74022…
## $ `[osoba]...13` <dbl> 481935, 31107, 36588, 33328, 10324, 30614, 38069, 65282…
## $ `[%]...14`     <dbl> 100.0, 6.5, 7.5, 7.7, 2.3, 6.8, 7.4, 14.1, 2.3, 8.6, 3.…
## $ `[%]...15`     <dbl> 100.0, 6.5, 7.4, 8.0, 2.1, 6.8, 7.2, 14.2, 2.4, 8.7, 3.…
## $ `[%]...16`     <dbl> 100.0, 6.6, 7.0, 7.3, 2.3, 6.5, 7.9, 14.0, 2.4, 8.3, 3.…
## $ `[%]...17`     <dbl> 100.0, 6.6, 6.9, 7.4, 2.0, 6.8, 7.8, 14.4, 2.4, 8.6, 3.…
## $ `[%]...18`     <dbl> 100.0, 6.5, 6.7, 8.4, 2.1, 7.2, 7.1, 15.4, 2.2, 8.9, 4.…
## $ `[%]...19`     <dbl> 100.0, 6.5, 6.6, 8.6, 2.0, 7.1, 7.0, 15.4, 2.3, 9.1, 4.…
## $ `[%]...20`     <dbl> 100.0, 6.6, 6.3, 7.8, 2.1, 6.8, 7.8, 14.9, 2.3, 8.5, 4.…
## $ `[%]...21`     <dbl> 100.0, 6.7, 6.1, 8.0, 1.9, 7.3, 7.7, 15.5, 2.3, 8.8, 4.…
## $ `[%]...22`     <dbl> 100.0, 6.4, 8.1, 7.1, 2.4, 6.5, 7.6, 13.1, 2.5, 8.3, 3.…
## $ `[%]...23`     <dbl> 100.0, 6.4, 8.0, 7.5, 2.3, 6.5, 7.4, 13.3, 2.5, 8.4, 3.…
## $ `[%]...24`     <dbl> 100.0, 6.5, 7.6, 6.9, 2.4, 6.2, 8.0, 13.2, 2.5, 8.2, 3.…
## $ `[%]...25`     <dbl> 100.0, 6.5, 7.6, 6.9, 2.1, 6.4, 7.9, 13.5, 2.5, 8.5, 3.…

“Czyszczenie”.

# Przycinanie do właściwych zmiennych
bezrobocie <- bezrobocie[, c(1,17)]

# Nazywanie ich
names(bezrobocie) <- c("Teryt_woj", "Bezrobocie_proc_2021")

# wyłuskiwanie części kodu Teryt, pod kątem stworzenia klucza
bezrobocie$Kod_woj <- substr(x = bezrobocie$Teryt_woj, 
                             start = 1, 
                             stop = 2)

# uzupełnianie danych, kreowanie klucza
woj_slownik$lp2 <- woj_slownik$lp * 2
woj_slownik$Kod_woj <- ifelse(nchar(woj_slownik$lp2) == 1, 
                              paste0("0", woj_slownik$lp2), 
                              as.character(woj_slownik$lp2))

W końcu, łączenie danych.

bezrobocie <- merge(x = bezrobocie, 
                    y = woj_slownik, 
                    by = "Kod_woj")

(bezrobocie <- bezrobocie[, c(5,3)]) # pozostawienie kluczowych zmiennych
##                  Nazwa Bezrobocie_proc_2021
## 1               POLSKA                100.0
## 2         DOLNO?L?SKIE                  6.6
## 3   KUJAWSKO-POMORSKIE                  6.9
## 4            LUBELSKIE                  7.4
## 5             LUBUSKIE                  2.0
## 6           ?\xd3DZKIE                  6.8
## 7          MA?OPOLSKIE                  7.8
## 8          MAZOWIECKIE                 14.4
## 9             OPOLSKIE                  2.4
## 10        PODKARPACKIE                  8.6
## 11           PODLASKIE                  3.7
## 12           POMORSKIE                  5.3
## 13             ?L?SKIE                  8.5
## 14      ?WI?TOKRZYSKIE                  4.2
## 15 WARMI?SKO-MAZURSKIE                  4.8
## 16       WIELKOPOLSKIE                  5.6
## 17  ZACHODNIOPOMORSKIE                  4.9
bezrobocie <- bezrobocie[bezrobocie$Nazwa != "POLSKA",] # wiersz z Polską jest tu zbędny

# poprawianie polskich liter, zmiana kodowania znaków
bezrobocie$Nazwa <- iconv(x = bezrobocie$Nazwa, 
                          from = "cp1250", 
                          to = "utf8")



Wiele zbiorów


# zdefiniowanie ramek
(df1 <- data.frame(id=c(1, 2, 3, 4, 5),
                  revenue=c(34, 36, 40, 49, 43))) # przychody
##   id revenue
## 1  1      34
## 2  2      36
## 3  3      40
## 4  4      49
## 5  5      43
(df2 <- data.frame(id=c(1, 2, 5, 6, 7),
                  expenses=c(22, 26, 31, 40, 20))) # wydatki
##   id expenses
## 1  1       22
## 2  2       26
## 3  5       31
## 4  6       40
## 5  7       20
(df3 <- data.frame(id=c(1, 2, 4, 5, 7),
                  profit=c(12, 10, 14, 12, 9))) # zysk
##   id profit
## 1  1     12
## 2  2     10
## 3  4     14
## 4  5     12
## 5  7      9


{base}

# {base}
df_list <- list(df1, df2, df3)
Reduce(function(x, y) merge(x, y, all=TRUE), df_list)  
##   id revenue expenses profit
## 1  1      34       22     12
## 2  2      36       26     10
## 3  3      40       NA     NA
## 4  4      49       NA     14
## 5  5      43       31     12
## 6  6      NA       40     NA
## 7  7      NA       20      9

  • Reduce() aplikuje funkcję sekwencyjnie do elementów listy

  • merge(x, y, all=TRUE) wykonuje full outer join (łączenie pełne zewnętrzne)

  • Wynik: wszystkie id ze wszystkich ramek, z wartościami NA tam gdzie brakuje danych


{tidyverse}

library(tidyverse)

df_list <- list(df1, df2, df3)      

df_list %>% 
  reduce(full_join, by='id')
##   id revenue expenses profit
## 1  1      34       22     12
## 2  2      36       26     10
## 3  3      40       NA     NA
## 4  4      49       NA     14
## 5  5      43       31     12
## 6  6      NA       40     NA
## 7  7      NA       20      9

  • reduce() z tidyverse działa podobnie jak Reduce()

  • full_join(by='id') łączy ramki po kolumnie id

  • Wynik identyczny jak w metodzie 1



Fuzzy merging


(df1 <- data.frame(team=c('Mavericks', 'Nets', 'Warriors', 'Heat', 'Lakers'),
                  points=c(99, 90, 104, 117, 100)))
##        team points
## 1 Mavericks     99
## 2      Nets     90
## 3  Warriors    104
## 4      Heat    117
## 5    Lakers    100
(df2 <- data.frame(team=c('Mavricks', 'Warrors', 'Heat', 'Netts', 'Kings', 'Lakes'),
                  assists=c(22, 29, 17, 40, 32, 30)))
##       team assists
## 1 Mavricks      22
## 2  Warrors      29
## 3     Heat      17
## 4    Netts      40
## 5    Kings      32
## 6    Lakes      30


library(fuzzyjoin)
library(dplyr)


stringdist_join(df1, df2, 
                by='team', 
                mode='full', 
                method = "jw",
                max_dist=99, 
                distance_col='dist')  %>%
  group_by(team.x) %>%
  slice_min(order_by=dist, n=1)
## # A tibble: 5 × 5
## # Groups:   team.x [5]
##   team.x    points team.y   assists   dist
##   <chr>      <dbl> <chr>      <dbl>  <dbl>
## 1 Heat         117 Heat          17 0     
## 2 Lakers       100 Lakes         30 0.0556
## 3 Mavericks     99 Mavricks      22 0.0370
## 4 Nets          90 Netts         40 0.0667
## 5 Warriors     104 Warrors       29 0.0417

stringdist_join()

Łączy df1 i df2 używając algorytmu podobieństwa stringów:

  • by='team' - łączy po kolumnie team

  • mode='full' - full join (zachowuje wszystkie wiersze z obu ramek)

  • method = "jw" - używa metryki Jaro-Winkler do mierzenia podobieństwa tekstów

  • max_dist=99 - akceptuje pary o dystansie do 99 (praktycznie wszystkie możliwe dopasowania)

  • distance_col='dist' - tworzy kolumnę dist z wartością dystansu/niepodobieństwa


group_by(team.x) %>% slice_min(order_by=dist, n=1)

Dla każdej drużyny z df1:

  • Grupuje wyniki po team.x (nazwa z df1)

  • Wybiera tylko 1 najlepsze dopasowanie (najmniejszy dystans = największe podobieństwo)



“Reshape”


Case 2 

(ramka_long <- fread(file = "dane/frame_to_dc.csv"))
##       Teryt   Rok Wskaznik
##       <int> <int>    <num>
##  1:       0  2018    100.0
##  2:  200000  2018      6.5
##  3:  400000  2018      7.5
##  4:  600000  2018      7.7
##  5:  800000  2018      2.3
##  6: 1000000  2018      6.8
##  7: 1200000  2018      7.4
##  8: 1400000  2018     14.1
##  9: 1600000  2018      2.3
## 10: 1800000  2018      8.6
## 11: 2000000  2018      3.8
## 12: 2200000  2018      4.8
## 13: 2400000  2018      8.3
## 14: 2600000  2018      4.6
## 15: 2800000  2018      5.5
## 16: 3000000  2018      5.3
## 17: 3200000  2018      4.7
## 18:       0  2019    100.0
## 19:  200000  2019      6.5
## 20:  400000  2019      7.4
## 21:  600000  2019      8.0
## 22:  800000  2019      2.1
## 23: 1000000  2019      6.8
## 24: 1200000  2019      7.2
## 25: 1400000  2019     14.2
## 26: 1600000  2019      2.4
## 27: 1800000  2019      8.7
## 28: 2000000  2019      3.8
## 29: 2200000  2019      4.8
## 30: 2400000  2019      7.7
## 31: 2600000  2019      4.9
## 32: 2800000  2019      5.3
## 33: 3000000  2019      5.3
## 34: 3200000  2019      4.8
##       Teryt   Rok Wskaznik
# transpozycja, postać długa na krótką
(ramka_short <- dcast(data = ramka_long, 
                      formula = Teryt~Rok, 
                      value.var = "Wskaznik"))
## Key: <Teryt>
##       Teryt  2018  2019
##       <int> <num> <num>
##  1:       0 100.0 100.0
##  2:  200000   6.5   6.5
##  3:  400000   7.5   7.4
##  4:  600000   7.7   8.0
##  5:  800000   2.3   2.1
##  6: 1000000   6.8   6.8
##  7: 1200000   7.4   7.2
##  8: 1400000  14.1  14.2
##  9: 1600000   2.3   2.4
## 10: 1800000   8.6   8.7
## 11: 2000000   3.8   3.8
## 12: 2200000   4.8   4.8
## 13: 2400000   8.3   7.7
## 14: 2600000   4.6   4.9
## 15: 2800000   5.5   5.3
## 16: 3000000   5.3   5.3
## 17: 3200000   4.7   4.8


Case 3 

(ramka_short <- fread(file = "dane/frame_to_m.csv"))
##       Teryt       Rok Wskaznik_2018 Wskaznik_2019
##       <int>    <char>         <num>         <num>
##  1:       0 2018-2019         100.0         100.0
##  2:  200000 2018-2019           6.5           6.5
##  3:  400000 2018-2019           7.5           7.4
##  4:  600000 2018-2019           7.7           8.0
##  5:  800000 2018-2019           2.3           2.1
##  6: 1000000 2018-2019           6.8           6.8
##  7: 1200000 2018-2019           7.4           7.2
##  8: 1400000 2018-2019          14.1          14.2
##  9: 1600000 2018-2019           2.3           2.4
## 10: 1800000 2018-2019           8.6           8.7
## 11: 2000000 2018-2019           3.8           3.8
## 12: 2200000 2018-2019           4.8           4.8
## 13: 2400000 2018-2019           8.3           7.7
## 14: 2600000 2018-2019           4.6           4.9
## 15: 2800000 2018-2019           5.5           5.3
## 16: 3000000 2018-2019           5.3           5.3
## 17: 3200000 2018-2019           4.7           4.8
# transpozycja, postać krótka na gługą
(ramka_long <- melt(data = ramka_short)) # bez żadnych dodatkowych argumentów
##           Rok      variable    value
##        <char>        <fctr>    <num>
##  1: 2018-2019         Teryt 0.00e+00
##  2: 2018-2019         Teryt 2.00e+05
##  3: 2018-2019         Teryt 4.00e+05
##  4: 2018-2019         Teryt 6.00e+05
##  5: 2018-2019         Teryt 8.00e+05
##  6: 2018-2019         Teryt 1.00e+06
##  7: 2018-2019         Teryt 1.20e+06
##  8: 2018-2019         Teryt 1.40e+06
##  9: 2018-2019         Teryt 1.60e+06
## 10: 2018-2019         Teryt 1.80e+06
## 11: 2018-2019         Teryt 2.00e+06
## 12: 2018-2019         Teryt 2.20e+06
## 13: 2018-2019         Teryt 2.40e+06
## 14: 2018-2019         Teryt 2.60e+06
## 15: 2018-2019         Teryt 2.80e+06
## 16: 2018-2019         Teryt 3.00e+06
## 17: 2018-2019         Teryt 3.20e+06
## 18: 2018-2019 Wskaznik_2018 1.00e+02
## 19: 2018-2019 Wskaznik_2018 6.50e+00
## 20: 2018-2019 Wskaznik_2018 7.50e+00
## 21: 2018-2019 Wskaznik_2018 7.70e+00
## 22: 2018-2019 Wskaznik_2018 2.30e+00
## 23: 2018-2019 Wskaznik_2018 6.80e+00
## 24: 2018-2019 Wskaznik_2018 7.40e+00
## 25: 2018-2019 Wskaznik_2018 1.41e+01
## 26: 2018-2019 Wskaznik_2018 2.30e+00
## 27: 2018-2019 Wskaznik_2018 8.60e+00
## 28: 2018-2019 Wskaznik_2018 3.80e+00
## 29: 2018-2019 Wskaznik_2018 4.80e+00
## 30: 2018-2019 Wskaznik_2018 8.30e+00
## 31: 2018-2019 Wskaznik_2018 4.60e+00
## 32: 2018-2019 Wskaznik_2018 5.50e+00
## 33: 2018-2019 Wskaznik_2018 5.30e+00
## 34: 2018-2019 Wskaznik_2018 4.70e+00
## 35: 2018-2019 Wskaznik_2019 1.00e+02
## 36: 2018-2019 Wskaznik_2019 6.50e+00
## 37: 2018-2019 Wskaznik_2019 7.40e+00
## 38: 2018-2019 Wskaznik_2019 8.00e+00
## 39: 2018-2019 Wskaznik_2019 2.10e+00
## 40: 2018-2019 Wskaznik_2019 6.80e+00
## 41: 2018-2019 Wskaznik_2019 7.20e+00
## 42: 2018-2019 Wskaznik_2019 1.42e+01
## 43: 2018-2019 Wskaznik_2019 2.40e+00
## 44: 2018-2019 Wskaznik_2019 8.70e+00
## 45: 2018-2019 Wskaznik_2019 3.80e+00
## 46: 2018-2019 Wskaznik_2019 4.80e+00
## 47: 2018-2019 Wskaznik_2019 7.70e+00
## 48: 2018-2019 Wskaznik_2019 4.90e+00
## 49: 2018-2019 Wskaznik_2019 5.30e+00
## 50: 2018-2019 Wskaznik_2019 5.30e+00
## 51: 2018-2019 Wskaznik_2019 4.80e+00
##           Rok      variable    value
(ramka_long <- melt(data = ramka_short, id.vars = c("Teryt", "Rok"))) # "zostawienie" dwóch zmiennych w kolumnach
##       Teryt       Rok      variable value
##       <int>    <char>        <fctr> <num>
##  1:       0 2018-2019 Wskaznik_2018 100.0
##  2:  200000 2018-2019 Wskaznik_2018   6.5
##  3:  400000 2018-2019 Wskaznik_2018   7.5
##  4:  600000 2018-2019 Wskaznik_2018   7.7
##  5:  800000 2018-2019 Wskaznik_2018   2.3
##  6: 1000000 2018-2019 Wskaznik_2018   6.8
##  7: 1200000 2018-2019 Wskaznik_2018   7.4
##  8: 1400000 2018-2019 Wskaznik_2018  14.1
##  9: 1600000 2018-2019 Wskaznik_2018   2.3
## 10: 1800000 2018-2019 Wskaznik_2018   8.6
## 11: 2000000 2018-2019 Wskaznik_2018   3.8
## 12: 2200000 2018-2019 Wskaznik_2018   4.8
## 13: 2400000 2018-2019 Wskaznik_2018   8.3
## 14: 2600000 2018-2019 Wskaznik_2018   4.6
## 15: 2800000 2018-2019 Wskaznik_2018   5.5
## 16: 3000000 2018-2019 Wskaznik_2018   5.3
## 17: 3200000 2018-2019 Wskaznik_2018   4.7
## 18:       0 2018-2019 Wskaznik_2019 100.0
## 19:  200000 2018-2019 Wskaznik_2019   6.5
## 20:  400000 2018-2019 Wskaznik_2019   7.4
## 21:  600000 2018-2019 Wskaznik_2019   8.0
## 22:  800000 2018-2019 Wskaznik_2019   2.1
## 23: 1000000 2018-2019 Wskaznik_2019   6.8
## 24: 1200000 2018-2019 Wskaznik_2019   7.2
## 25: 1400000 2018-2019 Wskaznik_2019  14.2
## 26: 1600000 2018-2019 Wskaznik_2019   2.4
## 27: 1800000 2018-2019 Wskaznik_2019   8.7
## 28: 2000000 2018-2019 Wskaznik_2019   3.8
## 29: 2200000 2018-2019 Wskaznik_2019   4.8
## 30: 2400000 2018-2019 Wskaznik_2019   7.7
## 31: 2600000 2018-2019 Wskaznik_2019   4.9
## 32: 2800000 2018-2019 Wskaznik_2019   5.3
## 33: 3000000 2018-2019 Wskaznik_2019   5.3
## 34: 3200000 2018-2019 Wskaznik_2019   4.8
##       Teryt       Rok      variable value


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


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