Zastosowanie funkcji do każdego wiersza tabeli za pomocą dplyr?
Podczas pracy z plyr często uważałem za przydatne użycie adply dla funkcji skalarnych, które muszę zastosować do każdego rzędu.
Np.
data(iris)
library(plyr)
head(
adply(iris, 1, transform , Max.Len= max(Sepal.Length,Petal.Length))
)
Sepal.Length Sepal.Width Petal.Length Petal.Width Species Max.Len
1 5.1 3.5 1.4 0.2 setosa 5.1
2 4.9 3.0 1.4 0.2 setosa 4.9
3 4.7 3.2 1.3 0.2 setosa 4.7
4 4.6 3.1 1.5 0.2 setosa 4.6
5 5.0 3.6 1.4 0.2 setosa 5.0
6 5.4 3.9 1.7 0.4 setosa 5.4
Teraz używam dplyr więcej, zastanawiam się, czy jest jakiś schludny / naturalny sposób, aby to zrobić? Ponieważ to jest a nie to czego chcę:
library(dplyr)
head(
mutate(iris, Max.Len= max(Sepal.Length,Petal.Length))
)
Sepal.Length Sepal.Width Petal.Length Petal.Width Species Max.Len
1 5.1 3.5 1.4 0.2 setosa 7.9
2 4.9 3.0 1.4 0.2 setosa 7.9
3 4.7 3.2 1.3 0.2 setosa 7.9
4 4.6 3.1 1.5 0.2 setosa 7.9
5 5.0 3.6 1.4 0.2 setosa 7.9
6 5.4 3.9 1.7 0.4 setosa 7.9
7 answers
Od dplyr 0.2 (chyba) rowwise() jest zaimplementowany, więc odpowiedź na ten problem brzmi:
iris %>%
rowwise() %>%
mutate(Max.Len= max(Sepal.Length,Petal.Length))
Non rowwise alternative
Pięć lat (!) później ta odpowiedź nadal dostaje dużo ruchu. Ponieważ został podany, rowwise jest coraz bardziej nie zalecany, chociaż wielu ludzi wydaje się, że jest intuicyjny. Zrób sobie przysługę i przejrzyj przepływy pracy Jenny Bryan zorientowane na wiersze w R z materiałem tidyverse, aby uzyskać dobrą poradę w tym temacie.
Najbardziej prosty sposób, który znalazłem, opiera się na jednym z przykładów Hadleya za pomocą pmap:
iris %>%
mutate(Max.Len= purrr::pmap_dbl(list(Sepal.Length, Petal.Length), max))
Używając tego podejścia, możesz podać dowolną liczbę argumentów funkcji (.f) wewnątrz pmap.
pmap jest dobrym podejściem koncepcyjnym, ponieważ odzwierciedla fakt, że podczas wykonywania operacji mądrych wierszy faktycznie pracujesz z krotkami z listy wektorów (kolumn w ramce danych).
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2019-08-06 03:20:42
Podejście idiomatyczne będzie polegało na stworzeniu odpowiednio wektoryzowanej funkcji.
R podaj pmax, który jest odpowiedni tutaj, jednak dostarcza również Vectorize jako wrapper dla mapply, aby umożliwić utworzenie wektoryzowanej dowolnej wersji dowolnej funkcji.
library(dplyr)
# use base R pmax (vectorized in C)
iris %>% mutate(max.len = pmax(Sepal.Length, Petal.Length))
# use vectorize to create your own function
# for example, a horribly inefficient get first non-Na value function
# a version that is not vectorized
coalesce <- function(a,b) {r <- c(a[1],b[1]); r[!is.na(r)][1]}
# a vectorized version
Coalesce <- Vectorize(coalesce, vectorize.args = c('a','b'))
# some example data
df <- data.frame(a = c(1:5,NA,7:10), b = c(1:3,NA,NA,6,NA,10:8))
df %>% mutate(ab =Coalesce(a,b))
Zauważ, że implementacja wektoryzacji w C / C++ będzie szybsza, ale nie ma magicPony pakietu, który napisze funkcję za Ciebie.
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2015-11-11 13:15:57
Musisz pogrupować według wiersza:
iris %>% group_by(1:n()) %>% mutate(Max.Len= max(Sepal.Length,Petal.Length))
To właśnie zrobił 1 w adply.
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2015-11-11 13:23:18
Aktualizacja 2017-08-03
Po napisaniu tego, Hadley zmienił kilka rzeczy ponownie. Funkcje, które kiedyś były w purrr, są teraz w nowym mieszanym pakiecie o nazwie purrrlyr, opisany jako:
Purrrlyr zawiera pewne funkcje leżące na przecięciu purrr i dplyr. Zostały one usunięte z purrr w celu uczynienia pakietu lżejszym i ponieważ zostały zastąpione przez inne rozwiązania w tidyverse.
Więc będziesz trzeba zainstalować + załadować ten pakiet, aby poniższy kod działał.
Original post
Hadley często zmienia zdanie co do tego, czego powinniśmy użyć, ale myślę, że powinniśmy przełączyć się na funkcje w purrr , aby uzyskać funkcję by row. Przynajmniej oferują te same funkcje i mają prawie taki sam interfejs jak adply z plyr.
Istnieją dwie powiązane funkcje, by_row i invoke_rows. Rozumiem, że używasz by_row, gdy chcesz zapętlić wiersze i dodać wyniki do danych.rama. invoke_rows jest używany, gdy zapętlasz wiersze danych.frame i przekazać każdy col jako argument do funkcji. Użyjemy tylko pierwszego.
Przykłady
library(tidyverse)
iris %>%
by_row(..f = function(this_row) {
browser()
})
To pozwala nam zobaczyć wewnętrzne (abyśmy mogli zobaczyć, co robimy), co jest tym samym, co robimy z adply.
Called from: ..f(.d[[i]], ...)
Browse[1]> this_row
# A tibble: 1 × 5
Sepal.Length Sepal.Width Petal.Length Petal.Width Species
<dbl> <dbl> <dbl> <dbl> <fctr>
1 5.1 3.5 1.4 0.2 setosa
Browse[1]> Q
Domyślnie, by_row dodaje kolumnę listy na podstawie wyjścia:
iris %>%
by_row(..f = function(this_row) {
this_row[1:4] %>% unlist %>% mean
})
Daje:
# A tibble: 150 × 6
Sepal.Length Sepal.Width Petal.Length Petal.Width Species .out
<dbl> <dbl> <dbl> <dbl> <fctr> <list>
1 5.1 3.5 1.4 0.2 setosa <dbl [1]>
2 4.9 3.0 1.4 0.2 setosa <dbl [1]>
3 4.7 3.2 1.3 0.2 setosa <dbl [1]>
4 4.6 3.1 1.5 0.2 setosa <dbl [1]>
5 5.0 3.6 1.4 0.2 setosa <dbl [1]>
6 5.4 3.9 1.7 0.4 setosa <dbl [1]>
7 4.6 3.4 1.4 0.3 setosa <dbl [1]>
8 5.0 3.4 1.5 0.2 setosa <dbl [1]>
9 4.4 2.9 1.4 0.2 setosa <dbl [1]>
10 4.9 3.1 1.5 0.1 setosa <dbl [1]>
# ... with 140 more rows
Jeśli zamiast tego zwrócimy data.frame, otrzymujemy listę z data.frame s:
iris %>%
by_row( ..f = function(this_row) {
data.frame(
new_col_mean = this_row[1:4] %>% unlist %>% mean,
new_col_median = this_row[1:4] %>% unlist %>% median
)
})
Daje:
# A tibble: 150 × 6
Sepal.Length Sepal.Width Petal.Length Petal.Width Species .out
<dbl> <dbl> <dbl> <dbl> <fctr> <list>
1 5.1 3.5 1.4 0.2 setosa <data.frame [1 × 2]>
2 4.9 3.0 1.4 0.2 setosa <data.frame [1 × 2]>
3 4.7 3.2 1.3 0.2 setosa <data.frame [1 × 2]>
4 4.6 3.1 1.5 0.2 setosa <data.frame [1 × 2]>
5 5.0 3.6 1.4 0.2 setosa <data.frame [1 × 2]>
6 5.4 3.9 1.7 0.4 setosa <data.frame [1 × 2]>
7 4.6 3.4 1.4 0.3 setosa <data.frame [1 × 2]>
8 5.0 3.4 1.5 0.2 setosa <data.frame [1 × 2]>
9 4.4 2.9 1.4 0.2 setosa <data.frame [1 × 2]>
10 4.9 3.1 1.5 0.1 setosa <data.frame [1 × 2]>
# ... with 140 more rows
Sposób dodawania wyjścia funkcji jest kontrolowany przez .collate param. Są trzy opcje: list, rows, cols. Gdy nasze wyjście ma długość 1, nie ma znaczenia, czy używamy rows czy cols.
iris %>%
by_row(.collate = "cols", ..f = function(this_row) {
this_row[1:4] %>% unlist %>% mean
})
iris %>%
by_row(.collate = "rows", ..f = function(this_row) {
this_row[1:4] %>% unlist %>% mean
})
Oba produkują:
# A tibble: 150 × 6
Sepal.Length Sepal.Width Petal.Length Petal.Width Species .out
<dbl> <dbl> <dbl> <dbl> <fctr> <dbl>
1 5.1 3.5 1.4 0.2 setosa 2.550
2 4.9 3.0 1.4 0.2 setosa 2.375
3 4.7 3.2 1.3 0.2 setosa 2.350
4 4.6 3.1 1.5 0.2 setosa 2.350
5 5.0 3.6 1.4 0.2 setosa 2.550
6 5.4 3.9 1.7 0.4 setosa 2.850
7 4.6 3.4 1.4 0.3 setosa 2.425
8 5.0 3.4 1.5 0.2 setosa 2.525
9 4.4 2.9 1.4 0.2 setosa 2.225
10 4.9 3.1 1.5 0.1 setosa 2.400
# ... with 140 more rows
Jeśli wyprowadzimy dane.ramka z 1 rzędem, liczy się tylko nieznacznie, którego używamy:
iris %>%
by_row(.collate = "cols", ..f = function(this_row) {
data.frame(
new_col_mean = this_row[1:4] %>% unlist %>% mean,
new_col_median = this_row[1:4] %>% unlist %>% median
)
})
iris %>%
by_row(.collate = "rows", ..f = function(this_row) {
data.frame(
new_col_mean = this_row[1:4] %>% unlist %>% mean,
new_col_median = this_row[1:4] %>% unlist %>% median
)
})
Oba dają:
# A tibble: 150 × 8
Sepal.Length Sepal.Width Petal.Length Petal.Width Species .row new_col_mean new_col_median
<dbl> <dbl> <dbl> <dbl> <fctr> <int> <dbl> <dbl>
1 5.1 3.5 1.4 0.2 setosa 1 2.550 2.45
2 4.9 3.0 1.4 0.2 setosa 2 2.375 2.20
3 4.7 3.2 1.3 0.2 setosa 3 2.350 2.25
4 4.6 3.1 1.5 0.2 setosa 4 2.350 2.30
5 5.0 3.6 1.4 0.2 setosa 5 2.550 2.50
6 5.4 3.9 1.7 0.4 setosa 6 2.850 2.80
7 4.6 3.4 1.4 0.3 setosa 7 2.425 2.40
8 5.0 3.4 1.5 0.2 setosa 8 2.525 2.45
9 4.4 2.9 1.4 0.2 setosa 9 2.225 2.15
10 4.9 3.1 1.5 0.1 setosa 10 2.400 2.30
# ... with 140 more rows
Z tym, że drugi ma kolumnę nazywany .row, a pierwszy nie.
Wreszcie, jeśli nasze wyjście jest dłuższe niż długość 1 albo jako vector lub jako data.frame z rows, to ma znaczenie, czy używamy rows lub cols dla .collate:
mtcars[1:2] %>% by_row(function(x) 1:5)
mtcars[1:2] %>% by_row(function(x) 1:5, .collate = "rows")
mtcars[1:2] %>% by_row(function(x) 1:5, .collate = "cols")
Produkuje odpowiednio:
# A tibble: 32 × 3
mpg cyl .out
<dbl> <dbl> <list>
1 21.0 6 <int [5]>
2 21.0 6 <int [5]>
3 22.8 4 <int [5]>
4 21.4 6 <int [5]>
5 18.7 8 <int [5]>
6 18.1 6 <int [5]>
7 14.3 8 <int [5]>
8 24.4 4 <int [5]>
9 22.8 4 <int [5]>
10 19.2 6 <int [5]>
# ... with 22 more rows
# A tibble: 160 × 4
mpg cyl .row .out
<dbl> <dbl> <int> <int>
1 21 6 1 1
2 21 6 1 2
3 21 6 1 3
4 21 6 1 4
5 21 6 1 5
6 21 6 2 1
7 21 6 2 2
8 21 6 2 3
9 21 6 2 4
10 21 6 2 5
# ... with 150 more rows
# A tibble: 32 × 7
mpg cyl .out1 .out2 .out3 .out4 .out5
<dbl> <dbl> <int> <int> <int> <int> <int>
1 21.0 6 1 2 3 4 5
2 21.0 6 1 2 3 4 5
3 22.8 4 1 2 3 4 5
4 21.4 6 1 2 3 4 5
5 18.7 8 1 2 3 4 5
6 18.1 6 1 2 3 4 5
7 14.3 8 1 2 3 4 5
8 24.4 4 1 2 3 4 5
9 22.8 4 1 2 3 4 5
10 19.2 6 1 2 3 4 5
# ... with 22 more rows
Więc, podsumowując. Jeśli chcesz mieć funkcjonalność adply(.margins = 1, ...), możesz użyć by_row.
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2017-07-03 20:47:30
Rozszerzenie odpowiedzi Brodiega,
Jeśli funkcja zwraca więcej niż jeden wiersz, to zamiast mutate(), do() musi być używany. Następnie, aby połączyć go z powrotem, użyj rbind_all() z pakietu dplyr.
W wersji dplyr dplyr_0.1.2, użycie 1:n() w klauzuli group_by() nie działa dla mnie. Mam nadzieję, że [[18]}Hadley wdroży rowwise() wkrótce.
iris %>%
group_by(1:nrow(iris)) %>%
do(do_fn) %>%
rbind_all()
Testowanie wydajności,
library(plyr) # plyr_1.8.4.9000
library(dplyr) # dplyr_0.8.0.9000
library(purrr) # purrr_0.2.99.9000
library(microbenchmark)
d1_count <- 1000
d2_count <- 10
d1 <- data.frame(a=runif(d1_count))
do_fn <- function(row){data.frame(a=row$a, b=runif(d2_count))}
do_fn2 <- function(a){data.frame(a=a, b=runif(d2_count))}
op <- microbenchmark(
plyr_version = plyr::adply(d1, 1, do_fn),
dplyr_version = d1 %>%
dplyr::group_by(1:nrow(d1)) %>%
dplyr::do(do_fn(.)) %>%
dplyr::bind_rows(),
purrr_version = d1 %>% purrr::pmap_dfr(do_fn2),
times=50)
Ma następujące wyniki:
Unit: milliseconds
expr min lq mean median uq max neval
plyr_version 1227.2589 1275.1363 1317.3431 1293.5759 1314.4266 1616.5449 50
dplyr_version 977.3025 1012.6340 1035.9436 1025.6267 1040.5882 1449.0978 50
purrr_version 609.5790 629.7565 643.8498 644.2505 656.1959 686.8128 50
To pokazuje, że nowy purrr wersja jest najszybsza
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2019-01-09 18:50:58
Coś takiego?
iris$Max.Len <- pmax(iris$Sepal.Length, iris$Petal.Length)
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2014-02-16 23:24:14
Oprócz świetnej odpowiedzi udzielonej przez @ alexwhan, pamiętaj, że musisz użyć ungroup(), aby uniknąć skutków ubocznych. Dzieje się tak dlatego, że {[7] } jest operacją grupowania.
iris %>%
rowwise() %>%
mutate(Max.Len = max(Sepal.Length, Petal.Length))
Da ci:
Sepal.Length Sepal.Width Petal.Length Petal.Width Species Max.Len
<dbl> <dbl> <dbl> <dbl> <fct> <dbl>
1 5.1 3.5 1.4 0.2 setosa 5.1
2 4.9 3 1.4 0.2 setosa 4.9
3 4.7 3.2 1.3 0.2 setosa 4.7
4 4.6 3.1 1.5 0.2 setosa 4.6
5 5 3.6 1.4 0.2 setosa 5
6 5.4 3.9 1.7 0.4 setosa 5.4
7 4.6 3.4 1.4 0.3 setosa 4.6
8 5 3.4 1.5 0.2 setosa 5
9 4.4 2.9 1.4 0.2 setosa 4.4
10 4.9 3.1 1.5 0.1 setosa 4.9
Załóżmy teraz, że musisz kontynuować dplyr, aby dodać lead do Max.Len:
iris %>%
rowwise() %>%
mutate(Max.Len = max(Sepal.Length, Petal.Length)) %>%
mutate(Lead.Max.Len = lead(Max.Len))
To da:
Sepal.Length Sepal.Width Petal.Length Petal.Width Species Max.Len Lead.Max.Len
<dbl> <dbl> <dbl> <dbl> <fct> <dbl> <dbl>
1 5.1 3.5 1.4 0.2 setosa 5.1 NA
2 4.9 3 1.4 0.2 setosa 4.9 NA
3 4.7 3.2 1.3 0.2 setosa 4.7 NA
4 4.6 3.1 1.5 0.2 setosa 4.6 NA
5 5 3.6 1.4 0.2 setosa 5 NA
6 5.4 3.9 1.7 0.4 setosa 5.4 NA
7 4.6 3.4 1.4 0.3 setosa 4.6 NA
8 5 3.4 1.5 0.2 setosa 5 NA
9 4.4 2.9 1.4 0.2 setosa 4.4 NA
10 4.9 3.1 1.5 0.1 setosa 4.9 NA
NA's są produkowane jako efekt uboczny. Można to poprawić za pomocą ungroup():
iris %>%
rowwise() %>%
mutate(Max.Len = max(Sepal.Length, Petal.Length)) %>%
ungroup() %>%
mutate(Lead.Max.Len = lead(Max.Len))
To będzie produkować pożądane wyjście:
Sepal.Length Sepal.Width Petal.Length Petal.Width Species Max.Len lead.max.len
<dbl> <dbl> <dbl> <dbl> <fct> <dbl> <dbl>
1 5.1 3.5 1.4 0.2 setosa 5.1 4.9
2 4.9 3 1.4 0.2 setosa 4.9 4.7
3 4.7 3.2 1.3 0.2 setosa 4.7 4.6
4 4.6 3.1 1.5 0.2 setosa 4.6 5
5 5 3.6 1.4 0.2 setosa 5 5.4
6 5.4 3.9 1.7 0.4 setosa 5.4 4.6
7 4.6 3.4 1.4 0.3 setosa 4.6 5
8 5 3.4 1.5 0.2 setosa 5 4.4
9 4.4 2.9 1.4 0.2 setosa 4.4 4.9
10 4.9 3.1 1.5 0.1 setosa 4.9 5.4
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2020-09-20 11:12:23