Отправка метода для функций внутри dplyr :: do - PullRequest
Новая
       26

Отправка метода для функций внутри dplyr :: do

0 голосов
/ 08 января 2019

Как мне реализовать диспетчеризацию метода для функции внутри dplyr::do?

Я прочитал о проблемах GitHub # 719 , # 3558 и # 3429 , которые содержат полезную информацию о том, как создавать методы для dplyr глаголов. , но ничего особенного, что работает для dplyr::do - что является своего рода «особенным» в том смысле, что отправка должна происходить не только для самого dplyr:do, но и для функции, которая вызывается внутри dplyr::do (или по крайней мере, это то, что я после)

Вот что я попробовал:

Отборочные 

library(dplyr)
#> 
#> Attache Paket: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union

# Example data ------------------------------------------------------------

df <- tibble::tibble(
  id = c(rep("A", 5), rep("B", 5)),
  x = 1:10
)

df_custom <- df
class(df_custom) <- c("tbl_df_custom", class(df_custom))

# Reclass function --------------------------------------------------------

reclass <- function(x, result) {
  UseMethod('reclass')
}

reclass.default <- function(x, result) {
  class(result) <- unique(c(class(x)[[1]], class(result)))
  attr(result, class(x)[[1]]) <- attr(x, class(x)[[1]])
  result
}

Шаг 1: попытаться определить метод для глагола dplyr 

# Custom method for summarize ---------------------------------------------

summarise.tbl_df_custom <- function (.data, ...) {
  message("Custom method for `summarise`")
  result <- NextMethod("summarise")
  ret <- reclass(.data, result)
  print(class(ret))
  ret
}

ret <- df_custom %>%
  summarise(y = mean(x))
#> Custom method for `summarise`
#> [1] "tbl_df_custom" "tbl_df"        "tbl"           "data.frame"
ret %>% class()
#> [1] "tbl_df_custom" "tbl_df"        "tbl"           "data.frame"

Шаг 2: попробуйте определить метод для другого глагола dplyr для проверки более длинного канала 

# Custom method for group_by ----------------------------------------------

group_by.tbl_df_custom <- function (.data, ..., add = FALSE) {
  message("Custom method for `group_by`")
  result <- NextMethod("group_by")
  ret <- reclass(.data, result)
  print(class(ret))
  ret
}

ret <- df_custom %>%
  group_by(id) %>%
  summarise(y = mean(x))
#> Custom method for `group_by`
#> [1] "tbl_df_custom" "grouped_df"    "tbl_df"        "tbl"          
#> [5] "data.frame"
#> Custom method for `summarise`
#> [1] "tbl_df_custom" "tbl_df"        "tbl"           "data.frame"
ret %>% class()
#> [1] "tbl_df_custom" "tbl_df"        "tbl"           "data.frame"

Шаг 3: попробуем то же самое для do

# Custom method for do ----------------------------------------------------

do.tbl_df_custom <- function (.data, ...) {
  message("custom method for `do`")
  result <- NextMethod("do")
  ret <- reclass(.data, result)
  print(class(ret))
  ret
}

foo <- function(df) {
  UseMethod("foo")
}

foo.default <- function(df) {
  message("Default method for `foo`")
  df %>%
    summarise(y = mean(x))
}

foo.tbl_df_custom <- function(df) {
  message("Custom method for `foo`")
  df %>%
    summarise(y = mean(x) * 100)
}

ret <- df_custom %>%
  group_by(id) %>%
  do(foo(.))
#> Custom method for `group_by`
#> [1] "tbl_df_custom" "grouped_df"    "tbl_df"        "tbl"          
#> [5] "data.frame"
#> custom method for `do`
#> Default method for `foo`
#> Default method for `foo`
#> [1] "tbl_df_custom" "grouped_df"    "tbl_df"        "tbl"          
#> [5] "data.frame"
ret
#> # A tibble: 2 x 2
#> # Groups:   id [2]
#>   id        y
#>   <chr> <dbl>
#> 1 A         3
#> 2 B         8
ret %>% class()
#> [1] "tbl_df_custom" "grouped_df"    "tbl_df"        "tbl"          
#> [5] "data.frame"

Хотя на первый взгляд все в порядке, проблема в том, что для foo вызывается метод default вместо *1033* custom .

Создано в 2019-01-08 пакетом Представить (v0.2.1)

Ответы [ 2 ]

0 голосов
/ 08 января 2019

Для того, чтобы иметь полный и автономный пример со всем кодом от начала до конца для моего конкретного примера, я также выложу здесь собственный ответ.

Несколько вещей, которые нужно выделить:

  1. За исключением моего пользовательского метода для group_by(), я мог бы поменять reclass() на гораздо лучший vctrs::vec_restore(), который также имеет метод data.frame (см. library(vctrs); sloop::s3_methods_generic("vec_restore")).

    Дополнительную информацию о vctrs::vec_restore() можно найти в главе Наследование S3 для Advanced R , а также в статье о S3 в https://vctrs.r -lib.org. /

    Было бы замечательно, если бы в vctrs::vec_restore() был что-то вроде аргумента combine, чтобы он учитывал атрибут класса grouped_df(), который добавляется путем вызова метода по умолчанию group_by(), но это другая история ( за что я подал любознательный выпуск GitHub ).

    В настоящее время наша пользовательская информация о классе будет отброшена из-за способа реализации vctrs::vec_restore() (см. «Тестирование» ниже).

  2. Проблемы с GitHub, которые я нашел очень полезными: # 3429 и особенно # 3923

Код 

library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union

# Constructor for tbl_df_custom class -------------------------------------

new_df_custom <- function(x = tibble()) {
  stopifnot(tibble::is_tibble(x))
  structure(x, class = c("tbl_df_custom", class(x)))
}

# Example data ------------------------------------------------------------

df_custom <- new_df_custom(
  x = tibble::tibble(
    id = c(rep("A", 3), rep("B", 3)),
    x = 1:6
  )
)

df_custom
#> # A tibble: 6 x 2
#>   id        x
#> * <chr> <int>
#> 1 A         1
#> 2 A         2
#> 3 A         3
#> 4 B         4
#> 5 B         5
#> 6 B         6
df_custom %>% class()
#> [1] "tbl_df_custom" "tbl_df"        "tbl"           "data.frame"

# Reclass function for preserving custom class attribute ------------------

reclass <- function(x, to) {
  UseMethod('reclass')
}

reclass.default <- function(x, to) {
  class(x) <- unique(c(class(to)[[1]], class(x)))
  attr(x, class(to)[[1]]) <- attr(to, class(to)[[1]])
  x
}

# Custom method for summarise ---------------------------------------------

summarise.tbl_df_custom <- function (.data, ...) {
  message("Custom method for `summarise`")
  vctrs::vec_restore(NextMethod(), .data)
}

# Custom method for group_by ----------------------------------------------

group_by.tbl_df_custom <- function (.data, ..., add = FALSE, 
  use_vec_restore = FALSE
) {
  message("Custom method for `group_by`")
  retval <- reclass(NextMethod(), .data)
  print(class(retval))
  retval
}

# Custom method for ungroup ----------------------------------------------

ungroup.tbl_df_custom <- function (.data, ...) {
  message("custom method for `ungroup`")
  vctrs::vec_restore(NextMethod(), .data)
}

# Custom method for do ----------------------------------------------------

do.tbl_df_custom <- function (.data, ...) {
  message("custom method for `do`")
  vctrs::vec_restore(NextMethod(), .data)
}

# Custom extraction method ------------------------------------------------

`[.tbl_df_custom` <- function(x, ...) {
  message("custom method for `[`")
  new_df_custom(NextMethod())
}

# Create custom methods for foo -------------------------------------------

foo <- function(df) {
  UseMethod("foo")
}

foo.default <- function(df) {
  message("Default method for `foo`")
  df %>%
    summarise(y = mean(x))
}

foo.tbl_df_custom <- function(df) {
  message("Custom method for `foo`")
  df %>%
    summarise(y = mean(x) * 100)
}

# Testing things out ------------------------------------------------------

retval <- df_custom %>%
  group_by(id) %>%
  do(foo(.))
#> Custom method for `group_by`
#> [1] "tbl_df_custom" "grouped_df"    "tbl_df"        "tbl"          
#> [5] "data.frame"
#> custom method for `do`
#> custom method for `ungroup`
#> custom method for `[`
#> Custom method for `foo`
#> Custom method for `summarise`
#> custom method for `[`
#> Custom method for `foo`
#> Custom method for `summarise`

retval
#> custom method for `[`
#> custom method for `ungroup`
#> # A tibble: 2 x 2
#> # Groups:   id [2]
#>   id        y
#>   <chr> <dbl>
#> 1 A       200
#> 2 B       500
retval %>% class()
#> [1] "tbl_df_custom" "grouped_df"    "tbl_df"        "tbl"          
#> [5] "data.frame"

Создано в 2019-01-08 пакетом Представить (v0.2.1)

Альтернатива reclass(): vctrs::vec_restore()

# Alternative version for group_by that uses vctrs::vec_restore -----------

group_by.tbl_df_custom <- function (.data, ..., add = FALSE) {
  message("Custom method for `group_by`")
  retval <- vctrs::vec_restore(NextMethod(), .data)
  print(class(retval))
  retval
}

retval <- df_custom %>%
  group_by(id) %>%
  do(foo(.))
#> Custom method for `group_by`
#> [1] "tbl_df_custom" "tbl_df"        "tbl"           "data.frame"
#> custom method for `do`
#> Custom method for `foo`
#> Custom method for `summarise`

retval
#> custom method for `[`
#> # A tibble: 1 x 1
#>       y
#>   <dbl>
#> 1   350
retval %>% class()
#> [1] "tbl_df_custom" "tbl_df"        "tbl"           "data.frame"

Создано в 2019-01-08 пакетом Представить (v0.2.1)

Как упоминалось выше, обратите внимание, что при использовании альтернативной версии group_by(), которая использует vctrs::vec_restore() вместо reclass(), атрибут класса grouped_df удаляется.

Альтернатива reclass(): vec_restore_inclusive()

Это собственная реализация, которая пытается использовать способ, которым работает vctrs::vec_restore(), а также учитывает атрибуты to при принятии решения о том, как выполнить «сброс». Возможно, «объединить» или «выровнять» было бы лучшим названием компонентов для функции. 

vec_restore_inclusive <- function(x, to) {
  UseMethod('vec_restore_inclusive')
}

vec_restore_inclusive.data.frame <- function (x, to) {
  attr_to <- attributes(to)
  attr_x <- attributes(x)
  attr_use <- if (
    length(classes_preserve <- setdiff(attr_to[["class"]], attr_x[["class"]]))
  ) {
    attr_x
  } else {
    attr_to
  }

  attr_use[["names"]] <- attr_x[["names"]]
  attr_use[["row.names"]] <- .set_row_names(vctrs:::df_length(x))
  attr_use[["class"]] <- unique(c(classes_preserve, attr_x[["class"]]))
  attributes(x) <- attr_use
  x
}

group_by.tbl_df_custom <- function (.data, ..., add = FALSE) {
  message("Custom method for `group_by`")
  retval <- vec_restore_inclusive(NextMethod(), .data)
  print(class(retval))
  retval
}

retval <- df_custom %>%
  group_by(id) %>%
  do(foo(.))
#> Custom method for `group_by`
#> [1] "tbl_df_custom" "grouped_df"    "tbl_df"        "tbl"          
#> [5] "data.frame"
#> custom method for `do`
#> custom method for `ungroup`
#> custom method for `[`
#> Custom method for `foo`
#> Custom method for `summarise`
#> custom method for `[`
#> Custom method for `foo`
#> Custom method for `summarise`

retval
#> custom method for `[`
#> custom method for `ungroup`
#> # A tibble: 2 x 2
#> # Groups:   id [2]
#>   id        y
#>   <chr> <dbl>
#> 1 A       200
#> 2 B       500
retval %>% class()
#> [1] "tbl_df_custom" "grouped_df"    "tbl_df"        "tbl"          
#> [5] "data.frame"

Создано в 2019-01-08 пакетом Представить (v0.2.1)

0 голосов
/ 08 января 2019

Итак, проблема связана с этим вопросом, который я только что задал . Я смог решить ее, определив 3 новых функции: ungroup.tbl_df_custom, функция конструктора класса и [.tbl_df_custom. 

ungroup.tbl_df_custom <- function (.data, ...) {
  message("custom method for `ungroup`")
  result <- NextMethod("ungroup")
  ret <- reclass(.data, result)
  ret
}


new_custom <- function(x, ...) {

  structure(x, class = c("tbl_df_custom", class(x)))
}

`[.tbl_df_custom` <- function(x, ...) {
  new_custom(NextMethod())
}



df_custom2 <- new_custom(df)


df_custom2 %>%
  group_by(id) %>%
  do(foo(.))

Custom method for `group_by`
[1] "tbl_df_custom" "grouped_df"    "tbl_df"        "tbl"           "data.frame"   
custom method for `do`
custom method for `ungroup`
Custom method for `foo`
Custom method for `summarise`
[1] "tbl_df_custom" "tbl_df"        "tbl"           "data.frame"   
Custom method for `foo`
Custom method for `summarise`
[1] "tbl_df_custom" "tbl_df"        "tbl"           "data.frame"   
[1] "tbl_df_custom" "grouped_df"    "tbl_df"        "tbl"           "data.frame"   
custom method for `ungroup`
# A tibble: 2 x 2
# Groups:   id [2]
  id        y
  <chr> <dbl>
1 A       300
2 B       800
...