quick implementation of most of ggraph/ggforce

DESCRIPTION

@@ -77,6 +77,9 @@ Suggests:
     palmerpenguins,
     rversions,
     reticulate
+Enhances:
+    ggforce,
+    ggraph
 LazyData: true
 RoxygenNote: 7.1.2
 Encoding: UTF-8

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")
+}

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, ...)
+}