From 4af1d3ba13fa4fd98fa755bc8ac8811625000170 Mon Sep 17 00:00:00 2001 From: Carson Sievert Date: Wed, 22 Aug 2018 10:31:29 -0500 Subject: [PATCH 1/3] add initial support for translation of GeomEdgePath/GeomEdgeDensity/GeomTreemap --- NAMESPACE | 6 ++++++ R/ggplotly.R | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 64 insertions(+) create mode 100644 R/ggplotly.R diff --git a/NAMESPACE b/NAMESPACE index c921e49d..07d6f47f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -203,6 +203,12 @@ export(set_graph_style) export(square) export(th_foreground) export(theme_graph) +export(to_basic.GeomEdgeBezier) +export(to_basic.GeomEdgeBspline) +export(to_basic.GeomEdgeDensity) +export(to_basic.GeomEdgePath) +export(to_basic.GeomEdgeSegment) +export(to_basic.GeomTreemap) export(treeApply) export(tree_apply) export(unset_graph_style) diff --git a/R/ggplotly.R b/R/ggplotly.R new file mode 100644 index 00000000..8dc4afca --- /dev/null +++ b/R/ggplotly.R @@ -0,0 +1,58 @@ +# --------------------------------------------------------------------------- +# Translations for R/geom_axis_hive.R +# --------------------------------------------------------------------------- + +# TODO: waiting for an example + +# --------------------------------------------------------------------------- +# Translations for R/geom_edge.R +# --------------------------------------------------------------------------- + +toPath <- function(data, prestats_data, layout, params, p, ...) { + data$alpha <- data$alpha %||% params$edge_alpha %||% 1 + prefix_class(data, "GeomPath") +} + +#' @export +to_basic.GeomEdgePath <- toPath + +#' @export +to_basic.GeomEdgeSegment <- toPath + +#' @export +to_basic.GeomEdgeBezier <- toPath + +#' @export +to_basic.GeomEdgeBspline <- toPath + +# --------------------------------------------------------------------------- +# Translations for R/geom_edge_density.R +# --------------------------------------------------------------------------- + +#' @export +to_basic.GeomEdgeDensity <- function(data, prestats_data, layout, params, p, ...) { + # avoid a weird precision issue + data$density[data$density < 0.005] <- 0 + data$fill_plotlyDomain <- data$density + data$fill <- toRGB( + data$edge_fill, scales::rescale(data$density) + ) + prefix_class(data, "GeomTile") +} + +# --------------------------------------------------------------------------- +# Translations for R/geom_treemap.R +# --------------------------------------------------------------------------- + +#' @export +to_basic.GeomTreemap <- getFromNamespace("to_basic.GeomRect", asNamespace("plotly")) + + +# --------------------------------------------------------------------------- +# Helper functions +# --------------------------------------------------------------------------- + +prefix_class <- function(x, y) { + structure(x, class = unique(c(y, class(x)))) +} + From 1b59bfdcb67472bf16b88b266eee6d69449fbcf6 Mon Sep 17 00:00:00 2001 From: Carson Sievert Date: Wed, 22 Aug 2018 10:56:23 -0500 Subject: [PATCH 2/3] GeomTreemap -> GeomNodeTile; add GeomEdgePoint; better organize methods --- NAMESPACE | 3 ++- R/ggplotly.R | 27 ++++++++++++++------------- 2 files changed, 16 insertions(+), 14 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 07d6f47f..3caa22e3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -207,8 +207,9 @@ export(to_basic.GeomEdgeBezier) export(to_basic.GeomEdgeBspline) export(to_basic.GeomEdgeDensity) export(to_basic.GeomEdgePath) +export(to_basic.GeomEdgePoint) export(to_basic.GeomEdgeSegment) -export(to_basic.GeomTreemap) +export(to_basic.GeomNodeTile) export(treeApply) export(tree_apply) export(unset_graph_style) diff --git a/R/ggplotly.R b/R/ggplotly.R index 8dc4afca..7cc960ab 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -5,7 +5,7 @@ # TODO: waiting for an example # --------------------------------------------------------------------------- -# Translations for R/geom_edge.R +# Translations for custom Edge geoms # --------------------------------------------------------------------------- toPath <- function(data, prestats_data, layout, params, p, ...) { @@ -13,22 +13,12 @@ toPath <- function(data, prestats_data, layout, params, p, ...) { prefix_class(data, "GeomPath") } -#' @export -to_basic.GeomEdgePath <- toPath - -#' @export -to_basic.GeomEdgeSegment <- toPath - #' @export to_basic.GeomEdgeBezier <- toPath #' @export to_basic.GeomEdgeBspline <- toPath -# --------------------------------------------------------------------------- -# Translations for R/geom_edge_density.R -# --------------------------------------------------------------------------- - #' @export to_basic.GeomEdgeDensity <- function(data, prestats_data, layout, params, p, ...) { # avoid a weird precision issue @@ -40,12 +30,23 @@ to_basic.GeomEdgeDensity <- function(data, prestats_data, layout, params, p, ... prefix_class(data, "GeomTile") } +#' @export +to_basic.GeomEdgePath <- toPath + +#' @export +to_basic.GeomEdgeSegment <- toPath + +#' @export +to_basic.GeomEdgePoint <- function(data, prestats_data, layout, params, p, ...) { + prefix_class(data, "GeomPoint") +} + # --------------------------------------------------------------------------- -# Translations for R/geom_treemap.R +# Translations for custom Node geoms # --------------------------------------------------------------------------- #' @export -to_basic.GeomTreemap <- getFromNamespace("to_basic.GeomRect", asNamespace("plotly")) +to_basic.GeomNodeTile <- getFromNamespace("to_basic.GeomTile", asNamespace("plotly")) # --------------------------------------------------------------------------- From aaaec3dc7726c99d3cd2c89292ae8a314dcb8563 Mon Sep 17 00:00:00 2001 From: Carson Sievert Date: Wed, 22 Aug 2018 11:46:04 -0500 Subject: [PATCH 3/3] strip special 'edge_' prefix on trained aes mappings --- R/ggplotly.R | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/R/ggplotly.R b/R/ggplotly.R index 7cc960ab..21c9c32c 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -8,18 +8,18 @@ # Translations for custom Edge geoms # --------------------------------------------------------------------------- -toPath <- function(data, prestats_data, layout, params, p, ...) { - data$alpha <- data$alpha %||% params$edge_alpha %||% 1 +toEdgePath <- function(data, prestats_data, layout, params, p, ...) { + names(data) <- sub("^edge_", "", names(data)) prefix_class(data, "GeomPath") } -#' @export -to_basic.GeomEdgeBezier <- toPath +#' @rawNamespace export(to_basic.GeomEdgeBezier) +to_basic.GeomEdgeBezier <- toEdgePath -#' @export -to_basic.GeomEdgeBspline <- toPath +#' @rawNamespace export(to_basic.GeomEdgeBspline) +to_basic.GeomEdgeBspline <- toEdgePath -#' @export +#' @rawNamespace export(to_basic.GeomEdgeDensity) to_basic.GeomEdgeDensity <- function(data, prestats_data, layout, params, p, ...) { # avoid a weird precision issue data$density[data$density < 0.005] <- 0 @@ -30,13 +30,13 @@ to_basic.GeomEdgeDensity <- function(data, prestats_data, layout, params, p, ... prefix_class(data, "GeomTile") } -#' @export -to_basic.GeomEdgePath <- toPath +#' @rawNamespace export(to_basic.GeomEdgePath) +to_basic.GeomEdgePath <- toEdgePath -#' @export -to_basic.GeomEdgeSegment <- toPath +#' @rawNamespace export(to_basic.GeomEdgeSegment) +to_basic.GeomEdgeSegment <- toEdgePath -#' @export +#' @rawNamespace export(to_basic.GeomEdgePoint) to_basic.GeomEdgePoint <- function(data, prestats_data, layout, params, p, ...) { prefix_class(data, "GeomPoint") } @@ -45,7 +45,7 @@ to_basic.GeomEdgePoint <- function(data, prestats_data, layout, params, p, ...) # Translations for custom Node geoms # --------------------------------------------------------------------------- -#' @export +#' @rawNamespace export(to_basic.GeomNodeTile) to_basic.GeomNodeTile <- getFromNamespace("to_basic.GeomTile", asNamespace("plotly"))