मैं dplyr::do के अंदर किसी फ़ंक्शन के लिए विधि प्रेषण कैसे कार्यान्वित करूं?

मैंने गिटहब मुद्दों के माध्यम से पढ़ा है #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 के लिए कस्टम विधि के बजाय डिफ़ॉल्ट कहा जाता है।

2019-01-08 को reprex पैकेज द्वारा बनाया गया (v0.2.1)

3
Rappster 8 जिंदा 2019, 02:18

2 जवाब

सबसे बढ़िया उत्तर

मेरे विशेष उदाहरण के लिए शुरू से अंत तक सभी कोड के साथ एक पूर्ण और आत्मनिर्भर उदाहरण रखने के लिए, मैं यहां अपना उत्तर भी पोस्ट करूंगा।

हाइलाइट करने के लिए कुछ चीजें:

  1. group_by() के लिए मेरी कस्टम विधि को छोड़कर, मैं reclass() को बेहतर vctrs::vec_restore() के लिए स्वैप कर सकता था, जिसमें data.frame विधि भी होती है (देखें library(vctrs); sloop::s3_methods_generic("vec_restore")) .

    आप vctrs::vec_restore() के बारे में अधिक जानकारी अध्याय S3 इनहेरिटेंस ऑफ एडवांस्ड R में पा सकते हैं और साथ ही S3 वेक्टर लेख < पर a href="https://vctrs.r-lib.org/" rel="nofollow noreferrer">https://vctrs.r-lib.org/

    यह बहुत अच्छा होगा यदि combine तर्क की तरह vctrs::vec_restore() में इसे grouped_df() वर्ग विशेषता पर विचार करने के लिए group_by() की डिफ़ॉल्ट विधि को कॉल करके जोड़ा जाता है, लेकिन यह एक और कहानी है (जिसके लिए मैंने एक जिज्ञासु GitHub मुद्दा दायर किया है)।

    वर्तमान में, जिस तरह से vctrs::vec_restore() को लागू किया गया है, उसके कारण हमारी कस्टम क्लास की जानकारी हटा दी जाएगी (नीचे "चीजों का परीक्षण" देखें)।

  2. गिटहब मुद्दे मुझे बहुत मददगार लगे: #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 को reprex पैकेज द्वारा बनाया गया (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 को reprex पैकेज द्वारा बनाया गया (v0.2.1)

जैसा कि ऊपर उल्लेख किया गया है, ध्यान दें कि group_by() के वैकल्पिक संस्करण का उपयोग करते समय जो reclass() के बजाय vctrs::vec_restore() का उपयोग करता है, वर्ग विशेषता grouped_df को हटा दिया जाता है।

reclass() का विकल्प: vec_restore_inclusive()

यह एक स्वयं का कार्यान्वयन है जो "रीसेट" कैसे किया जाता है, इसके निर्णय में to की विशेषताओं पर विचार करते हुए vctrs::vec_restore() के काम करने के तरीके का लाभ उठाने का प्रयास करता है। यकीनन, "गठबंधन" या "संरेखण" फ़ंक्शन के लिए बेहतर नाम घटक होंगे।

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 को reprex पैकेज द्वारा बनाया गया (v0.2.1)

1
Rappster 8 जिंदा 2019, 17:04