diff --git a/DESCRIPTION b/DESCRIPTION index 42df6659f6..ff4c5caa43 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -77,6 +77,9 @@ Suggests: palmerpenguins, rversions, reticulate +Enhances: + ggforce, + ggraph LazyData: true RoxygenNote: 7.1.2 Encoding: UTF-8 diff --git a/R/ggplotly-extensions-ggforce.R b/R/ggplotly-extensions-ggforce.R new file mode 100644 index 0000000000..5671fac364 --- /dev/null +++ b/R/ggplotly-extensions-ggforce.R @@ -0,0 +1,79 @@ +#' @rawNamespace export(to_basic.GeomArc) +to_basic.GeomArc <- function(data, prestats_data, layout, params, p, ...) { + prefix_class(data, "GeomPath") +} + +#' @rawNamespace export(to_basic.GeomArc0) +to_basic.GeomArc0 <- function(data, prestats_data, layout, params, p, ...) { + # TODO: we should have another geom2trace method for curveGrob()... + prefix_class(data, "GeomPath") +} + +#' @rawNamespace export(to_basic.GeomArcBar) +to_basic.GeomArcBar <- function(data, prestats_data, layout, params, p, ...) { + prefix_class(data, "GeomPolygon") +} + +#' @rawNamespace export(to_basic.GeomBezier0) +to_basic.GeomBezier0 <- function(data, prestats_data, layout, params, p, ...) { + prefix_class(data, "GeomPath") +} + +#' @rawNamespace export(to_basic.GeomBspline0) +to_basic.GeomBspline0 <- function(data, prestats_data, layout, params, p, ...) { + prefix_class(data, "GeomPath") +} + +#' @rawNamespace export(to_basic.GeomBsplineClosed0) +to_basic.GeomBsplineClosed0 <- function(data, prestats_data, layout, params, p, ...) { + prefix_class(data, "GeomPath") +} + +#' @rawNamespace export(to_basic.GeomCircle) +to_basic.GeomCircle <- function(data, prestats_data, layout, params, p, ...) { + prefix_class(data, "GeomPolygon") +} + +#' @rawNamespace export(to_basic.GeomMarkCircle) +to_basic.GeomMarkCircle <- function(data, prestats_data, layout, params, p, ...) { + # TODO: need to incorporate logic from R/mark_circle.R + stop("not yet implemented") +} + +#' @rawNamespace export(to_basic.GeomMarkEllipsis) +to_basic.GeomMarkEllipsis <- function(data, prestats_data, layout, params, p, ...) { + # TODO: need to incorporate logic from R/mark_elipsis.R + stop("not yet implemented") +} + +#' @rawNamespace export(to_basic.GeomMarkHull) +to_basic.GeomMarkHull <- function(data, prestats_data, layout, params, p, ...) { + # TODO: need to incorporate logic from R/mark_hull.R + stop("not yet implemented") +} + +#' @rawNamespace export(to_basic.GeomMarkRect) +to_basic.GeomMarkRect <- function(data, prestats_data, layout, params, p, ...) { + prefix_class(data, "GeomPolygon") +} + +#' @rawNamespace export(to_basic.GeomParallelSetsAxes) +to_basic.GeomParallelSetsAxes <- function(data, prestats_data, layout, params, p, ...) { + browser() + prefix_class(data, "GeomPolygon") +} + +#' @rawNamespace export(to_basic.GeomPathInterpolate) +to_basic.GeomPathInterpolate <- function(data, prestats_data, layout, params, p, ...) { + prefix_class(data, "GeomPath") +} + +#' @rawNamespace export(to_basic.GeomShape) +to_basic.GeomShape <- function(data, prestats_data, layout, params, p, ...) { + prefix_class(data, "GeomPolygon") +} + +#' @rawNamespace export(to_basic.GeomSina) +to_basic.GeomSina <- function(data, prestats_data, layout, params, p, ...) { + prefix_class(data, "GeomPoint") +} diff --git a/R/ggplotly-extensions-ggraph.R b/R/ggplotly-extensions-ggraph.R new file mode 100644 index 0000000000..00378333d1 --- /dev/null +++ b/R/ggplotly-extensions-ggraph.R @@ -0,0 +1,51 @@ +# --------------------------------------------------------------------------- +# TODO: ggraph::GeomAxisHive +# --------------------------------------------------------------------------- + + + +# --------------------------------------------------------------------------- +# ggraph 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") +} + +# --------------------------------------------------------------------------- +# ggraph custom Node geoms +# --------------------------------------------------------------------------- + +#' @rawNamespace export(to_basic.GeomNodeTile) +to_basic.GeomNodeTile <- function(data, prestats_data, layout, params, p, ...) { + to_basic.GeomRect(data, prestats_data, layout, params, p, ...) +}