Есть ли способ передать функцию dplyr `do` вектор дополнительных аргументов?

Question

Мне было любопытно, есть ли способ передать dplyr's do функцию вектора дополнительных аргументов, которые будут применяться к каждой группе по очереди? Рассмотрим, например, если мы хотим сгруппировать набор данных mtcars по его переменной cyl и применить функцию head к результирующим группам (по одному для 4, 6 и 8 соответственно) с n = 1 для 4 группы, n = 2 для группа 6 и n = 3 для 8-й группы, объединив конечные результаты в единый блок данных.

Я могу сделать это с помощью mapply следующим образом:

temp <- mtcars %>% 
    split(mtcars$cyl) %>% 
    mapply(FUN = head, x = ., n = 1:3, SIMPLIFY = FALSE) 
rbind(temp[[1]], temp[[2]], temp[[3]]) 

мне было интересно, если есть эквивалент способ сделать это с dplyr? Я получил, насколько ниже, но был тупик о том, как передать head дополнительный аргумент, представляющий число строк, мы хотели бы, чтобы выбрать:

# only selects first row of each group 
mtcars %>% 
    group_by(cyl) %>% 
    do(data.frame(head(x = ., n = 1))) 

# throws an error because n expects a single number 
mtcars %>% 
    group_by(cyl) %>% 
    do(data.frame(head(x = ., n = 1:3))) 

Answer 1

Это также возможно без группировки вообще,

mtcars %>% arrange(cyl) %>% slice(rep(c(0, which(diff(cyl)>0)), 1:3) + sequence(1:3)) 

# mpg cyl disp hp drat wt qsec vs am gear carb 
# 1 22.8 4 108.0 93 3.85 2.320 18.61 1 1 4 1 
# 2 21.0 6 160.0 110 3.90 2.620 16.46 0 1 4 4 
# 3 21.0 6 160.0 110 3.90 2.875 17.02 0 1 4 4 
# 4 18.7 8 360.0 175 3.15 3.440 17.02 0 0 3 2 
# 5 14.3 8 360.0 245 3.21 3.570 15.84 0 0 3 4 
# 6 16.4 8 275.8 180 3.07 4.070 17.40 0 0 3 3 

Чтобы ответить на ваш вопрос о do более конкретно, из-за того, как он реализован (оценка выражения в цикле через подмножества), одним из способов сделать вашу функцию head, было бы заставить ее увеличивать переменную каждый раз, когда она вызывается.

## Define a function that increments a variable each time it is called 
heads <- (function() { n <- 0; function(dat) { n <<- n+1; dat[1:n, ] } })() 

mtcars %>% group_by(cyl) %>% do(heads(.)) 
# mpg cyl disp hp drat wt qsec vs am gear carb 
# 1 22.8 4 108.0 93 3.85 2.320 18.61 1 1 4 1 
# 2 21.0 6 160.0 110 3.90 2.620 16.46 0 1 4 4 
# 3 21.0 6 160.0 110 3.90 2.875 17.02 0 1 4 4 
# 4 18.7 8 360.0 175 3.15 3.440 17.02 0 0 3 2 
# 5 14.3 8 360.0 245 3.21 3.570 15.84 0 0 3 4 
# 6 16.4 8 275.8 180 3.07 4.070 17.40 0 0 3 3 

Answer 2

Хм, я уверен, что есть более элегантный способ сделать это, но:

group_index = 
    mtcars %>% 
    group_by(cyl) %>% 
    group_indices 

mtcars %>% 
    mutate(group_index = group_index) %>% 
    group_by(cyl) %>% 
    slice(group_index %>% first %>% seq) 

Answer 3

, если мы хотим, чтобы сгруппировать mtcars набора данных с помощью своего переменным цилом и применить функцию головки к полученным группам (по одному на 4, 6 и 8, соответственно) с п = 1 для 4 группа, n = 2 для группы 6 и n = 3 для группы 8

Во-первых, формализовать это понятие в data.frame:

heads = data.frame(cyl=c(4,6,8), n = 1:3) 

Затем вы можете объединить его в:

mtcars %>% left_join(heads) %>% group_by(cyl) %>% slice(seq(first(n))) 

#  mpg cyl disp hp drat wt qsec vs am gear carb  n 
# (dbl) (dbl) (dbl) (dbl) (dbl) (dbl) (dbl) (dbl) (dbl) (dbl) (dbl) (int) 
# 1 22.8  4 108.0 93 3.85 2.320 18.61  1  1  4  1  1 
# 2 21.0  6 160.0 110 3.90 2.620 16.46  0  1  4  4  2 
# 3 21.0  6 160.0 110 3.90 2.875 17.02  0  1  4  4  2 
# 4 18.7  8 360.0 175 3.15 3.440 17.02  0  0  3  2  3 
# 5 14.3  8 360.0 245 3.21 3.570 15.84  0  0  3  4  3 
# 6 16.4  8 275.8 180 3.07 4.070 17.40  0  0  3  3  3 

Я хотел бы также рассмотреть уворачиваясь дополнительные скобки с

... %>% slice(n %>% first %>% seq) 

do существует только в качестве взлома, когда другие функции dplyr не соответствуют заданию, d следует избегать.

Answer 4

будет что-то вроде этой работы. это решение специфично для примера mtcars, но в вашем случае может быть что-то подобное. она включает в себя создание своей собственной функции, которая имеет условные операторы на основе из колонки вы группирование прочь:

head_custom <- function(df, n){ 

    if(df$cyl == 4){ 
    ans <- head(df, n[1]) 
    } 

    if(df$cyl == 6){ 
    ans <- head(df, n[2]) 
    } 

    if(df$cyl == 8){ 
    ans <- head(df, n[3]) 
    } 

    return(ans) 
} 

mtcars %>% 
group_by(cyl) %>% 
do(head_custom(., n = 1:3))