Proper registration plotly methods for dplyr generics

Author: cpsievert

DESCRIPTION

@@ -75,7 +75,7 @@ Suggests:
     forcats,
     thematic
 LazyData: true
-RoxygenNote: 7.1.0
+RoxygenNote: 7.1.1
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 Remotes: 

NAMESPACE

@@ -3,11 +3,7 @@
 S3method(api_create,data.frame)
 S3method(api_create,ggplot)
 S3method(api_create,plotly)
-S3method(arrange_,plotly)
-S3method(distinct_,plotly)
-S3method(do_,plotly)
 S3method(embed_notebook,plotly)
-S3method(filter_,plotly)
 S3method(fortify,SharedData)
 S3method(geom2trace,GeomBar)
 S3method(geom2trace,GeomBlank)
@@ -25,12 +21,9 @@ S3method(ggplotly,"NULL")
 S3method(ggplotly,ggmatrix)
 S3method(ggplotly,ggplot)
 S3method(ggplotly,plotly)
-S3method(group_by_,plotly)
-S3method(groups,plotly)
 S3method(layout,matrix)
 S3method(layout,plotly)
 S3method(layout,shiny.tag.list)
-S3method(mutate_,plotly)
 S3method(plotly_build,"NULL")
 S3method(plotly_build,gg)
 S3method(plotly_build,list)
@@ -40,10 +33,6 @@ S3method(print,api_grid)
 S3method(print,api_grid_local)
 S3method(print,api_plot)
 S3method(print,plotly_data)
-S3method(rename_,plotly)
-S3method(select_,plotly)
-S3method(slice_,plotly)
-S3method(summarise_,plotly)
 S3method(to_basic,GeomAbline)
 S3method(to_basic,GeomAnnotationMap)
 S3method(to_basic,GeomArea)
@@ -78,8 +67,6 @@ S3method(to_basic,GeomTile)
 S3method(to_basic,GeomViolin)
 S3method(to_basic,GeomVline)
 S3method(to_basic,default)
-S3method(transmute_,plotly)
-S3method(ungroup,plotly)
 export("%>%")
 export(TeX)
 export(add_annotations)

R/onLoad.R

@@ -0,0 +1,41 @@
+.onLoad <- function(...) {
+  # These generics are defined in R/plotly_data.R
+  dplyr_generics <- c(
+    "groups", "ungroup", "group_by", "summarise", "mutate", "do", "arrange",
+    "select", "filter", "distinct", "slice", "rename", "transmute"
+  )
+  for (generic in dplyr_generics) {
+    register_s3_method("dplyr", generic, "plotly")
+    if (generic %in% c("groups", "ungroup")) {
+      next
+    }
+    register_s3_method("dplyr", paste0(generic, "_"), "plotly")
+  }
+}
+
+# copy/pasta from shiny:::register_s3_method
+register_s3_method <- function(pkg, generic, class, fun = NULL) {
+  stopifnot(is.character(pkg), length(pkg) == 1)
+  stopifnot(is.character(generic), length(generic) == 1)
+  stopifnot(is.character(class), length(class) == 1)
+  
+  if (is.null(fun)) {
+    fun <- get(paste0(generic, ".", class), envir = parent.frame())
+  } else {
+    stopifnot(is.function(fun))
+  }
+  
+  if (pkg %in% loadedNamespaces()) {
+    registerS3method(generic, class, fun, envir = asNamespace(pkg))
+  }
+  
+  # Always register hook in case pkg is loaded at some
+  # point the future (or, potentially, but less commonly,
+  # unloaded & reloaded)
+  setHook(
+    packageEvent(pkg, "onLoad"),
+    function(...) {
+      registerS3method(generic, class, fun, envir = asNamespace(pkg))
+    }
+  )
+}

R/plotly_data.R

@@ -104,125 +104,161 @@ highlight_key <- function(...) {
   crosstalk::SharedData$new(...)
 }
 
+# ---------------------------------------------------------------------------
+# dplyr methods
+# ---------------------------------------------------------------------------
+
 #' @rdname plotly_data
-#' @export
 groups.plotly <- function(x) {
-  dplyr::groups(plotly_data(x))
+  groups(plotly_data(x))
 }
 
 #' @rdname plotly_data
-#' @export
 ungroup.plotly <- function(x, ...) {
-  d <- dplyr::ungroup(plotly_data(x))
+  d <- ungroup(plotly_data(x), ...)
   add_data(x, d)
 }
 
 #' @rdname plotly_data
-#' @export
-group_by_.plotly <- function(.data, ..., .dots, add = FALSE) {
-  d <- plotly_data(.data)
-  additional_args <- dots_as_quosures(lazyeval::all_dots(.dots, ...))
-  d2 <- group_by_add(d, !!!additional_args, add = add)
+group_by.plotly <- function(.data, ...) {
+  d <- group_by(plotly_data(.data), ...)
+  if (crosstalk_key() %in% names(d)) {
+    d <- group_by_add(d, !!rlang::sym(crosstalk_key()), add = TRUE)
+  }
+  add_data(.data, d)
+}
+
+#' @rdname plotly_data
+mutate.plotly <- function(.data, ...) {
+  d <- mutate(plotly_data(.data), ...)
+  add_data(.data, d)
+}
+
+#' @rdname plotly_data
+do.plotly <- function(.data, ...) {
+  d <- do(plotly_data(.data), ...)
+  add_data(.data, d)
+}
+
+#' @rdname plotly_data
+summarise.plotly <- function(.data, ...) {
+  d <- summarise(plotly_data(.data), ...)
+  add_data(.data, d)
+}
+
+#' @rdname plotly_data
+arrange.plotly <- function(.data, ...) {
+  d <- arrange(plotly_data(.data), ...)
+  add_data(.data, d)
+}
+
+#' @rdname plotly_data
+select.plotly <- function(.data, ...) {
+  d <- select(plotly_data(.data), ...)
+  add_data(.data, d)
+}
+
+#' @rdname plotly_data
+filter.plotly <- function(.data, ...) {
+  d <- filter(plotly_data(.data), ...)
+  add_data(.data, d)
+}
+
+#' @rdname plotly_data
+distinct.plotly <- function(.data, ...) {
+  d <- distinct(plotly_data(.data), ...)
+  add_data(.data, d)
+}
+
+#' @rdname plotly_data
+slice.plotly <- function(.data, ...) {
+  d <- slice(plotly_data(.data), ...)
+  add_data(.data, d)
+}
+
+#' @rdname plotly_data
+rename.plotly <- function(.data, ...) {
+  d <- rename(plotly_data(.data), ...)
+  add_data(.data, d)
+}
+
+#' @rdname plotly_data
+transmute.plotly <- function(.data, ...) {
+  d <- transmute(plotly_data(.data), ...)
+  add_data(.data, d)
+}
+
+# ------------------------------------------------------------
+# Deprecated dplyr non-nse generics
+# ------------------------------------------------------------
+
+#' @rdname plotly_data
+group_by_.plotly <- function(.data, ...) {
+  d <- group_by_(plotly_data(.data), ...)
   # add crosstalk key as a group (to enable examples like demos/highlight-pipeline.R)
   if (crosstalk_key() %in% names(d)) {
-    d2 <- group_by_add(d2, !!rlang::sym(crosstalk_key()), add = TRUE)
+    d <- group_by_add(d, !!rlang::sym(crosstalk_key()), add = TRUE)
   }
-  add_data(.data, d2)
+  add_data(.data, d)
 }
 
 #' @rdname plotly_data
-#' @export
-summarise_.plotly <- function(.data, ..., .dots) {
-  d <- plotly_data(.data)
-  additional_args <- dots_as_quosures(lazyeval::all_dots(.dots, ...))
-  d <- dplyr::summarise(d, !!!additional_args)
+mutate_.plotly <- function(.data, ...) {
+  d <- mutate_(plotly_data(.data), ...)
   add_data(.data, d)
 }
 
 #' @rdname plotly_data
-#' @export
-mutate_.plotly <- function(.data, ..., .dots) {
-  d <- plotly_data(.data)
-  dotz <- lazyeval::all_dots(.dots, ...)
-  # '.' in a pipeline should really reference the data!!
-  lapply(dotz, function(x) { assign(".", d, x$env) })
-  set <- attr(d, "set")
-  d <- dplyr::mutate(d, !!!dots_as_quosures(dotz))
-  add_data(.data, structure(d, set = set))
+do_.plotly <- function(.data, ...) {
+  d <- do_(plotly_data(.data), ...)
+  add_data(.data, d)
 }
 
 #' @rdname plotly_data
-#' @export
-do_.plotly <- function(.data, ..., .dots) {
-  d <- plotly_data(.data)
-  dotz <- lazyeval::all_dots(.dots, ...)
-  # '.' in a pipeline should really reference the data!!
-  lapply(dotz, function(x) { assign(".", d, x$env) })
-  set <- attr(d, "set")
-  d <- dplyr::do(d, !!!dots_as_quosures(dotz))
-  add_data(.data, structure(d, set = set))
+summarise_.plotly <- function(.data, ...) {
+  d <- summarise_(plotly_data(.data), ...)
+  add_data(.data, d)
 }
 
 #' @rdname plotly_data
-#' @export
-arrange_.plotly <- function(.data, ..., .dots) {
-  d <- plotly_data(.data)
-  additional_args <- dots_as_quosures(lazyeval::all_dots(.dots, ...))
-  d <- dplyr::arrange(d, !!!additional_args)
+arrange_.plotly <- function(.data, ...) {
+  d <- arrange_(plotly_data(.data), ...)
   add_data(.data, d)
 }
 
 #' @rdname plotly_data
-#' @export
-select_.plotly <- function(.data, ..., .dots) {
-  d <- plotly_data(.data)
-  additional_args <- dots_as_quosures(lazyeval::all_dots(.dots, ...))
-  d <- dplyr::select(d, !!!additional_args)
+select_.plotly <- function(.data, ...) {
+  d <- select_(plotly_data(.data), ...)
   add_data(.data, d)
 }
 
 #' @rdname plotly_data
-#' @export
-filter_.plotly <- function(.data, ..., .dots) {
-  d <- plotly_data(.data)
-  additional_args <- dots_as_quosures(lazyeval::all_dots(.dots, ...))
-  d <- dplyr::filter(d, !!!additional_args)
+filter_.plotly <- function(.data, ...) {
+  d <- filter_(plotly_data(.data), ...)
   add_data(.data, d)
 }
 
 #' @rdname plotly_data
-#' @export
-distinct_.plotly <- function(.data, ..., .dots) {
-  d <- plotly_data(.data)
-  additional_args <- dots_as_quosures(lazyeval::all_dots(.dots, ...))
-  d <- dplyr::distinct(d, .dots = !!!additional_args)
+distinct_.plotly <- function(.data, ...) {
+  d <- distinct_(plotly_data(.data), ...)
   add_data(.data, d)
 }
 
 #' @rdname plotly_data
-#' @export
-slice_.plotly <- function(.data, ..., .dots) {
-  d <- plotly_data(.data)
-  additional_args <- dots_as_quosures(lazyeval::all_dots(.dots, ...))
-  d <- dplyr::slice(d, !!!additional_args)
+slice_.plotly <- function(.data, ...) {
+  d <- slice_(plotly_data(.data), ...)
   add_data(.data, d)
 }
 
 #' @rdname plotly_data
-#' @export
-rename_.plotly <- function(.data, ..., .dots) {
-  d <- plotly_data(.data)
-  additional_args <- dots_as_quosures(lazyeval::all_dots(.dots, ...))
-  d <- dplyr::rename(d, !!!additional_args)
+rename_.plotly <- function(.data, ...) {
+  d <- rename_(plotly_data(.data), ...)
   add_data(.data, d)
 }
 
 #' @rdname plotly_data
-#' @export
-transmute_.plotly <- function(.data, ..., .dots) {
-  d <- plotly_data(.data)
-  additional_args <- dots_as_quosures(lazyeval::all_dots(.dots, ...))
-  d <- dplyr::transmute(d, !!!additional_arg)
+transmute_.plotly <- function(.data, ...) {
+  d <- transmute_(plotly_data(.data), ...)
   add_data(.data, d)
 }
 

R/utils.R

@@ -1166,15 +1166,6 @@ longest_element <- function(x) {
     ""
 }
 
-# Apply rlang::as_quosure across a list or vector, but explicitly pass env
-# and expr to as_quosure
-dots_as_quosures <- function(x) {
-  if (!inherits(x, "lazy_dots")) {
-    stop("Expected lazy dots")
-  }
-  lapply(x, function(x) rlang::new_quosure(x$expr, x$env))
-}
-
 # A dplyr::group_by wrapper for the add argument
 group_by_add <- function(..., add = TRUE) {
   if (packageVersion('dplyr') >= '1.0') {