purrr w pigułce


  • map(.x, .f, …) lub map(.x, .f = ~ ZRÓB COŚ Z .x) - dla każdego elementu wektora lub listy .x wykonaj funkcję .f
  • map zwraca listę, aby otrzymać wynik w innym formacie możemy wykorzystać poniższe warianty:
    • map_lgl zwraca wektor wartości logicznych,
    • map_int zwraca wektor liczb całkowitych,
    • map_dbl zwraca wektor liczb zmiennoprzecinkowych,
    • map_chr zwraca wektor tekstowy.
  • map przyjmuję tylko jeden wektor/listę, dla większej ilości korzystamy z:
    • map2( .x, .y, .f, …) dla dwóch wektorów/list,
    • pmap( .l , .f , …) dla dwóch i więcej wektorów/list.

Przykład
z wykorzystaniem
danych iris

Zagnieżdżamy dane według gatunku:

library(magrittr)
library(broom)
library(tidyr)
library(dplyr)
library(purrr)
library(plotly)

iris_nstd <- iris %>% 
    nest(-Species) # zagnieżdża dane według wartości w kolumnie Species
## # A tibble: 3 x 2
##      Species              data
##       <fctr>            <list>
## 1     setosa <tibble [50 x 4]>
## 2 versicolor <tibble [50 x 4]>
## 3  virginica <tibble [50 x 4]>

Tworzymy wykres rozrzutu dla każdego gatunku:

iris_nstd %<>%
    # tworzy wykres rozrzutu dla każdego gatunku
    mutate(scatter = map2(data, 
                          Species, 
                          ~ plot_ly(.x, 
                                    x = ~ Sepal.Width, 
                                    y = ~ Sepal.Length, 
                                    type = 'scatter', 
                                    mode = 'markers', 
                                    name = .y) %>% 
                              config(displayModeBar = F))) 
## # A tibble: 3 x 3
##      Species              data      scatter
##       <fctr>            <list>       <list>
## 1     setosa <tibble [50 x 4]> <S3: plotly>
## 2 versicolor <tibble [50 x 4]> <S3: plotly>
## 3  virginica <tibble [50 x 4]> <S3: plotly>

Pojedyńczy wykres możemy wyświetlić za pomocą:

iris_nstd$scatter[[1]]

A wszystkie wykresy na jednym używając funkcji subplot:

scatters_titles <- subplot(iris_nstd$scatter, shareX = T, shareY = T) %>% 
    # dodaje tytuły do wykresów
    plotly::layout(showlegend = F,
                   annotations = list(
                       list(x = 0.13 , y = 1.03, text = iris_nstd$Species[[1]], 
                            showarrow = F, xref = 'paper', yref = 'paper', 
                            font = list(size = 15)),
                       list(x = 0.5 , y = 1.03, text = iris_nstd$Species[[2]], 
                            showarrow = F, xref = 'paper', yref = 'paper', 
                            font = list(size = 15)),
                       list(x = 0.9, y = 1.03, text = iris_nstd$Species[[3]], 
                            showarrow = F, xref = 'paper', yref = 'paper', 
                            font = list(size = 15))))

Wykresy z tytułami:

scatters_titles

Szacujemy funkcję liniową dla każdego gatunku:

iris_nstd %<>% 
    # dopasowuje model liniowy dla każdego gatunku osobno
    mutate(lm = map(data, 
                    ~ lm(data = ., 
                         Sepal.Length ~ Sepal.Width)), 
           lm_tidy = map(lm, tidy), # zwraca 'uporządkowaną' wersje modelu
           intercept = map_dbl(lm_tidy, ~ .[1, 2]), # tworzy kolumnę z wyrazem wolnym 
           coeff = map_dbl(lm_tidy, ~ .[2, 2])) # tworzy kolumnę ze współczynnikiem kierunkowym

iris_nstd %>% select(-data, -scatter)
## # A tibble: 3 x 5
##      Species       lm              lm_tidy intercept     coeff
##       <fctr>   <list>               <list>     <dbl>     <dbl>
## 1     setosa <S3: lm> <data.frame [2 x 5]>  2.639001 0.6904897
## 2 versicolor <S3: lm> <data.frame [2 x 5]>  3.539735 0.8650777
## 3  virginica <S3: lm> <data.frame [2 x 5]>  3.906836 0.9015345

Nanosimy oszacowaną funkcję liniowy na wykresy rozrzutu:

# funkcja nanosząca prognozę na wykres rozrzutu
plot_with_pred <- function(scatter, data, lm, intercept, coeff){
    scatter %>% 
        add_trace(x = data$Sepal.Width, 
                  y = predict(lm, data),
                  hoverinfo = 'text',
                  mode = 'line', 
                  text = paste0('y = ', round(intercept, 2), ' + ', round(coeff, 2), 'x')) %>% 
        plotly::layout(showlegend = F,
                       xaxis = list(title = ''))
}

iris_nstd %<>%
    # tworzy kolumnę z wykresami rozrzutu wraz z prognozą
    mutate(scatter_with_pred = pmap(list(scatter, data, lm, intercept, coeff), plot_with_pred))

Wykresy z oszacowaną funkcją liniową:

Podejście to możemy wykorzystać do tworzenia heatmap:

Korzyści ze stosowania purrra:


  • przetrzymujemy wszystko w jednej ramce danych - łatwiej rozeznać się co zostało już zrobione i znaleźć to czego potrzebujemy
  • kod jest bardziej zwięzły, bez powtórzeń