Retourner un tibble: comment vectoriser avec case_when?
J'ai une fonction qui renvoie un tibble. Il fonctionne bien, mais je veux le vectoriser.
library(tidyverse)
tibTest <- tibble(argX = 1:4, argY = 7:4)
square_it <- function(xx, yy) {
if(xx >= 4){
tibble(x = NA, y = NA)
} else if(xx == 3){
tibble(x = as.integer(), y = as.integer())
} else if (xx == 2){
tibble(x = xx^2 - 1, y = yy^2 -1)
} else {
tibble(x = xx^2, y = yy^2)
}
}
Il fonctionne bien dans un mutate quand je l'appelle avec map2, me donnant le résultat que je voulais:
tibTest %>%
mutate(sq = map2(argX, argY, square_it)) %>%
unnest()
## A tibble: 3 x 4
# argX argY x y
# <int> <int> <dbl> <dbl>
# 1 1 7 1 49
# 2 2 6 3 35
# 3 4 4 NA NA
Ma première tentative de vectorisation a échoué, et je peux voir pourquoi - je ne peux pas renvoyer un vecteur de tibbles.
square_it2 <- function(xx, yy){
case_when(
x >= 4 ~ tibble(x = NA, y = NA),
x == 3 ~ tibble(x = as.integer(), y = as.integer()),
x == 2 ~ tibble(x = xx^2 - 1, y = yy^2 -1),
TRUE ~ tibble(x = xx^2, y = yy^2)
)
}
# square_it2(4, 2) # FAILS
Ma prochaine tentative fonctionne bien sur une simple entrée. Je peux renvoyer une liste de tibbles, et c'est ce que je veux pour le unnest
square_it3 <- function(xx, yy){
case_when(
xx >= 4 ~ list(tibble(x = NA, y = NA)),
xx == 3 ~ list(tibble(x = as.integer(), y = as.integer())),
xx == 2 ~ list(tibble(x = xx^2 - 1, y = yy^2 -1)),
TRUE ~ list(tibble(x = xx^2, y = yy^2))
)
}
square_it3(4, 2)
# [[1]]
# # A tibble: 1 x 2
# x y
# <lgl> <lgl>
# 1 NA NA
Mais quand je l'appelle dans un mutate, cela ne me donne pas le résultat que j'ai eu avec square_it. Je peux en quelque sorte voir ce qui ne va pas. Dans le xx == 2 clause, xx agit comme une valeur atomique de 2. Mais lors de la construction du tibble, xx est un vecteur de longueur 4.
tibTest %>%
mutate(sq = square_it3(argX, argY)) %>%
unnest()
# # A tibble: 9 x 4
# argX argY x y
# <int> <int> <dbl> <dbl>
# 1 1 7 1 49
# 2 1 7 4 36
# 3 1 7 9 25
# 4 1 7 16 16
# 5 2 6 0 48
# 6 2 6 3 35
# 7 2 6 8 24
# 8 2 6 15 15
# 9 4 4 NA NA
Comment obtenir le même résultat qu'avec square_it, mais à partir d'une fonction vectorisée utilisant case_when?
Vous devez vous assurer que vous créez un tibble à 1 ligne à chaque appel de la fonction, puis le vectoriser.
Cela fonctionne que vous ayez des groupes rowwise ou non.
Vous pouvez le faire avec switch enveloppé dans un map2:
Voici un reprex:
library(tidyverse)
tibTest <- tibble(argX = 1:4, argY = 7:4)
square_it <- function(xx, yy) {
map2(xx, yy, function(x, y){
switch(which(c(x >= 4,
x == 3,
x == 2,
x < 4 & x != 3 & x != 2)),
tibble(x = NA, y = NA),
tibble(x = as.integer(), y = as.integer()),
tibble(x = x^2 - 1, y = y^2 -1),
tibble(x = x^2, y = y^2))})
}
tibTest %>% mutate(sq = square_it(argX, argY)) %>% unnest(cols = sq)
#> # A tibble: 3 x 4
#> argX argY x y
#> <int> <int> <dbl> <dbl>
#> 1 1 7 1 49
#> 2 2 6 3 35
#> 3 4 4 NA NA
Créé le 2020-05-16 par le package reprex (v0.3.0)
Nous définissons row_case_when qui a une interface de formule similaire à case_when sauf qu'il a un premier argument de .data, agit par ligne et s'attend à ce que la valeur de chaque jambe soit une trame de données. Il renvoie un data.frame/tibble. Enveloppés dans une liste, rowwise et unnest ne sont pas nécessaires.
case_when2 <- function (.data, ...) {
fs <- dplyr:::compact_null(rlang:::list2(...))
n <- length(fs)
if (n == 0) {
abort("No cases provided")
}
query <- vector("list", n)
value <- vector("list", n)
default_env <- rlang:::caller_env()
quos_pairs <- purrr::map2(fs, seq_along(fs), dplyr:::validate_formula,
rlang:::default_env, rlang:::current_env())
for (i in seq_len(n)) {
pair <- quos_pairs[[i]]
query[[i]] <- rlang::eval_tidy(pair$lhs, data = .data, env = default_env)
value[[i]] <- rlang::eval_tidy(pair$rhs, data = .data, env = default_env)
if (!is.logical(query[[i]])) {
abort_case_when_logical(pair$lhs, i, query[[i]])
}
if (query[[i]]) return(value[[i]])
}
}
row_case_when <- function(.data, ...) {
.data %>%
group_by(.group = 1:n(), !!!.data) %>%
do(case_when2(., ...)) %>%
mutate %>%
ungroup %>%
select(-.group)
}
Essai
Il est utilisé comme ceci:
library(dplyr)
tibTest <- tibble(argX = 1:4, argY = 7:4) # test data from question
tibTest %>%
row_case_when(argX >= 4 ~ tibble(x = NA, y = NA),
argX == 3 ~ tibble(x = as.integer(), y = as.integer()),
argX == 2 ~ tibble(x = argX^2 - 1, y = argY^2 -1),
TRUE ~ tibble(x = argX^2, y = argY^2)
)
donnant:
# A tibble: 3 x 4
argX argY x y
<int> <int> <dbl> <dbl>
1 1 7 1 49
2 2 6 3 35
3 4 4 NA NA
mutate_cond et mutate_when
Ce ne sont pas tout à fait les mêmes que row_case_when puisqu'ils ne passent pas par des conditions prenant la première vraie mais en utilisant des conditions mutuellement exclusives, ils peuvent être utilisés pour certains aspects de ce problème. Ils ne gèrent pas la modification du nombre de lignes dans le résultat mais nous pouvons utiliser dplyr::filter pour supprimer des lignes pour une condition particulière.
mutate_cond défini dans dplyr mute/remplace plusieurs colonnes sur un sous-ensemble de lignes est comme mutate sauf que le deuxième argument est une condition et les arguments suivants sont appliqués uniquement aux lignes pour lesquelles cette condition est vrai.
mutate_when défini dans dplyr mute/remplace plusieurs colonnes sur un sous-ensemble de lignes est similaire à case_when sauf que cela s'applique aux lignes, les valeurs de remplacement sont fournies dans une liste et les autres arguments sont des conditions et des listes. De plus, toutes les branches sont toujours exécutées en appliquant les valeurs de remplacement aux lignes satisfaisant les conditions (par opposition à, pour chaque ligne, effectuer le remplacement uniquement sur la première vraie branche). Pour obtenir un effet similaire à row_case_ quand assurez-vous que les conditions sont mutuellement exclusives.
# mutate_cond example
tibTest %>%
filter(argX != 3) %>%
mutate(x = NA_integer_, y = NA_integer_) %>%
mutate_cond(argX == 2, x = argX^2 - 1L, y = argY^2 - 1L) %>%
mutate_cond(argX < 2, x = argX^2, y = argY^2)
# mutate_when example
tibTest %>%
filter(argX != 3) %>%
mutate_when(TRUE, list(x = NA_integer_, y = NA_integer_),
argX == 2, list(x = argX^2 - 1L, y = argY^2 - 1L),
argX < 2, list(x = argX^2, y = argY^2))