Proper registration plotly methods for dplyr generics

Author: cpsievert

DESCRIPTION

@@ -72,6 +72,6 @@ Suggests:
     plotlyGeoAssets,
     forcats
 LazyData: true
-RoxygenNote: 7.1.0
+RoxygenNote: 7.1.1
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)

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,36 @@
+.onLoad <- function(...) {
+  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")
+  }
+}
+
+# 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,126 +104,159 @@ 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)
-  # add crosstalk key as a group (to enable examples like demos/highlight-pipeline.R)
+group_by.plotly <- function(.data, ...) {
+  d <- group_by(plotly_data(.data), ...)
   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
+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, ..., .dots, add = FALSE) {
+  args <- dots_as_quosures(lazyeval::all_dots(.dots, ...))
+  d <- group_by_add(plotly_data(.data), !!!args, add = add)
+  # add crosstalk key as a group (to enable examples like demos/highlight-pipeline.R)
+  if (crosstalk_key() %in% names(d)) {
+    d <- group_by_add(d, !!rlang::sym(crosstalk_key()), add = TRUE)
+  }
   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))
+  d <- dplyr::mutate_(d, .dots = lazyeval::all_dots(.dots, ...))
+  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))
+  d <- dplyr::do_(d, .dots = lazyeval::all_dots(.dots, ...))
+  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)
-  add_data(.data, d)
+  args <- dots_as_quosures(lazyeval::all_dots(.dots, ...))
+  arrange(d, !!!args)
 }
 
 #' @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)
-  add_data(.data, d)
+  args <- dots_as_quosures(lazyeval::all_dots(.dots, ...))
+  select(d, !!!args)
 }
 
 #' @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)
-  add_data(.data, d)
+  args <- dots_as_quosures(lazyeval::all_dots(.dots, ...))
+  filter(d, !!!args)
 }
 
 #' @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)
-  add_data(.data, d)
+  args <- dots_as_quosures(lazyeval::all_dots(.dots, ...))
+  distinct(d, !!!args)
 }
 
 #' @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)
-  add_data(.data, d)
+  args <- dots_as_quosures(lazyeval::all_dots(.dots, ...))
+  slice(d, !!!args)
 }
 
 #' @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)
-  add_data(.data, d)
+  args <- dots_as_quosures(lazyeval::all_dots(.dots, ...))
+  rename(d, !!!args)
 }
 
 #' @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)
-  add_data(.data, d)
+  args <- dots_as_quosures(lazyeval::all_dots(.dots, ...))
+  transmute(.data, !!!args)
 }
 
 # ---------------------------------------------------------------------------