web-dev-qa-db-ja.com

ティブルを返す：case_whenでベクトル化する方法は？

ティブルを返す関数があります。正常に動作しますが、ベクトル化したいと思います。

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)
  }
}

map2で呼び出すと、mutateで問題なく実行され、必要な結果が得られます。

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

それをベクトル化する私の最初の試みは失敗しました、そして私は理由を見ることができます-私はティブルのベクトルを返すことができません。

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

次の試みは、単純な入力でOKを実行します。ティブルのリストを返すことができます。これが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

しかし、それをmutateで呼び出すと、square_itで得られた結果が得られません。何が問題なのか、ちょっとわかります。 xx == 2句では、xxは2のアトミック値として機能しますが、ティブルの構築では、xxは長さ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

square_itで行ったのと同じ結果をどのように得ることができますが、case_whenを使用したベクトル化された関数からですか？

rdplyrtibbleunnest
6
David T

関数を呼び出すたびに1行のティブルを作成していることを確認してから、それをベクトル化する必要があります。

これは、rowwiseグループがあるかどうかに関係なく機能します。

map2にラップされたswitchでこれを行うことができます：

ここに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

reprexパッケージ （v0.3.0）によって2020-05-16に作成されました

2
Allan Cameron

row_case_whenを定義します。これはcase_whenと同様の数式インターフェイスを持ちますが、最初の引数が.dataであり、行ごとに機能し、各レッグの値がデータフレームであることを期待します。 data.frame/tibbleを返します。リストにラップする場合、rowwiseおよびunnestは不要です。

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)
}

テスト走行

これは次のように使用されます：

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)
  )

与える：

# 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およびmutate_when

これらはrow_case_whenとまったく同じではありません。最初のtrueの条件を実行しないためですが、相互に排他的な条件を使用することで、この問題の特定の側面に使用できます。結果の行数の変更は処理しませんが、dplyr::filterを使用して特定の条件の行を削除できます。

mutate_cond定義 dplyr mutate/replace複数の列のサブセットの列 はmutateと似ていますが、2番目の引数が条件であり、後続の引数がその条件は真です。

mutate_when定義 dplyr mutate/replace複数の列のサブセットの行 はcase_whenに似ていますが、行に適用され、置換値はリストと代替引数で提供されます条件とリストです。また、すべてのレッグは常に、条件を満たす行に置換値を適用して実行されます（各行に対して、最初の真のレッグのみで置換を実行するのではなく）。 row_case_ whenと同様の効果を得るには、条件が相互に排他的であることを確認してください。

# 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))
3
G. Grothendieck