diff --git a/NAMESPACE b/NAMESPACE index c921e49d..3caa22e3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -203,6 +203,13 @@ 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.GeomEdgePoint) +export(to_basic.GeomEdgeSegment) +export(to_basic.GeomNodeTile) 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..21c9c32c --- /dev/null +++ b/R/ggplotly.R @@ -0,0 +1,59 @@ +# --------------------------------------------------------------------------- +# Translations for R/geom_axis_hive.R +# --------------------------------------------------------------------------- + +# TODO: waiting for an example + +# --------------------------------------------------------------------------- +# Translations for custom Edge geoms +# --------------------------------------------------------------------------- + +toEdgePath <- function(data, prestats_data, layout, params, p, ...) { + names(data) <- sub("^edge_", "", names(data)) + prefix_class(data, "GeomPath") +} + +#' @rawNamespace export(to_basic.GeomEdgeBezier) +to_basic.GeomEdgeBezier <- toEdgePath + +#' @rawNamespace export(to_basic.GeomEdgeBspline) +to_basic.GeomEdgeBspline <- toEdgePath + +#' @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 + data$fill_plotlyDomain <- data$density + data$fill <- toRGB( + data$edge_fill, scales::rescale(data$density) + ) + prefix_class(data, "GeomTile") +} + +#' @rawNamespace export(to_basic.GeomEdgePath) +to_basic.GeomEdgePath <- toEdgePath + +#' @rawNamespace export(to_basic.GeomEdgeSegment) +to_basic.GeomEdgeSegment <- toEdgePath + +#' @rawNamespace export(to_basic.GeomEdgePoint) +to_basic.GeomEdgePoint <- function(data, prestats_data, layout, params, p, ...) { + prefix_class(data, "GeomPoint") +} + +# --------------------------------------------------------------------------- +# Translations for custom Node geoms +# --------------------------------------------------------------------------- + +#' @rawNamespace export(to_basic.GeomNodeTile) +to_basic.GeomNodeTile <- getFromNamespace("to_basic.GeomTile", asNamespace("plotly")) + + +# --------------------------------------------------------------------------- +# Helper functions +# --------------------------------------------------------------------------- + +prefix_class <- function(x, y) { + structure(x, class = unique(c(y, class(x)))) +} +