From b2232b1b332b44a394eb181a7d7b43d20d171891 Mon Sep 17 00:00:00 2001
From: cpsievert <cpsievert1@gmail.com>
Date: Thu, 10 Mar 2016 20:24:09 +1100
Subject: [PATCH] add GeomSpoke; sketch some ideas for arrow()

---
 NAMESPACE         |  1 +
 R/ggplotly.R      |  6 +++---
 R/layers2traces.R | 50 ++++++++++++++++++++++++++++++++++++++++++++---
 3 files changed, 51 insertions(+), 6 deletions(-)

diff --git a/NAMESPACE b/NAMESPACE
index 58ce37def5..9db21fb88e 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -31,6 +31,7 @@ S3method(to_basic,GeomRect)
 S3method(to_basic,GeomRibbon)
 S3method(to_basic,GeomSegment)
 S3method(to_basic,GeomSmooth)
+S3method(to_basic,GeomSpoke)
 S3method(to_basic,GeomStep)
 S3method(to_basic,GeomTile)
 S3method(to_basic,GeomViolin)
diff --git a/R/ggplotly.R b/R/ggplotly.R
index f52ad91624..2df026cd91 100644
--- a/R/ggplotly.R
+++ b/R/ggplotly.R
@@ -220,12 +220,12 @@ gg2list <- function(p, width = NULL, height = NULL, mapping = "all", source = "A
         if ("datetime" %in% scaleName) forMat <- function(x) as.POSIXct(x / 1000, origin = "1970-01-01")
         # convert "days from the UNIX epoch" to a date/datetime
         if ("date" %in% scaleName) forMat <- function(x) as.Date(as.POSIXct(x * 86400, origin = "1970-01-01"))
-      } else {
-        if (aesName != "text") aesName <- paste0(aesName, "_plotlyDomain")
       }
       # add a line break if hovertext already exists
       if ("hovertext" %in% names(x)) x$hovertext <- paste0(x$hovertext, "<br>")
-      x$hovertext <- paste0(x$hovertext, varName, ": ", forMat(x[[aesName]]))
+      x$hovertext <- paste0(
+        x$hovertext, varName, ": ", forMat(x[[paste0(aesName, "_plotlyDomain")]] %||% x[[aesName]])
+      )
     }
     x
   }, data, aesMap)
diff --git a/R/layers2traces.R b/R/layers2traces.R
index 7d67139b71..b7c099cbea 100644
--- a/R/layers2traces.R
+++ b/R/layers2traces.R
@@ -175,9 +175,7 @@ to_basic.GeomStep <- function(data, prestats_data, layout, params, ...) {
 }
 
 #' @export
-to_basic.GeomSegment <- function(data, prestats_data, layout, params, ...) {
-  # Every row is one segment, we convert to a line with several
-  # groups which can be efficiently drawn by adding NA rows.
+to_basic.GeomSpoke <- function(data, prestats_data, layout, params, ...) {
   data$group <- seq_len(nrow(data))
   others <- data[!names(data) %in% c("x", "y", "xend", "yend")]
   data <- with(data, {
@@ -187,6 +185,52 @@ to_basic.GeomSegment <- function(data, prestats_data, layout, params, ...) {
   prefix_class(data, "GeomPath")
 }
 
+#' @export
+to_basic.GeomSegment <- function(data, prestats_data, layout, params, ...) {
+  if (grid::is.unit(params$arrow$length)) {
+    # arrows are an extension of the line segment, and we know the arrow length
+    # (think r in polar coordinates), so we find the angle of the segment 
+    # wrt to x-axis (i.e., theta in polar)
+    thetas <- atan2(abs(data$y - data$yend), abs(data$x - data$xend))
+    arrowLength <- unitConvert(params$arrow$length, "npc", "width")
+    lay <- tidyr::gather_(layout, "variable", "x", c("x_min", "x_max"))
+    # arrow length on the data scale
+    r <- arrowLength * diff(lay$x) * 10
+    # do everything in radians
+    arrowAngle <- (params$arrow$angle / 2) * (pi / 180)
+    data$x1 <- data$xend + sign(data$x - data$xend) * r * cos(thetas + arrowAngle)
+    data$x2 <- data$xend + sign(data$x - data$xend) * r * cos(thetas - arrowAngle)
+    data$y1 <- data$yend + sign(data$y - data$yend) * r * sin(thetas + arrowAngle)
+    data$y2 <- data$yend + sign(data$y - data$yend) * r * sin(thetas - arrowAngle)
+    # probably wrong
+    #R <- r / cos(arrowAngle / 2)
+    #data$xside1 <- data$xArrowBase + R * cos(arrowAngle / 2)
+    #data$yside1 <- data$yArrowBase + R * sin(arrowAngle / 2)
+    #data$xside2 <- data$xArrowBase + R * cos(-arrowAngle / 2)
+    #data$yside2 <- data$yArrowBase + R * sin(-arrowAngle / 2)
+    ## TODO: group by PANEL at least!
+    data$group <- seq_len(nrow(data))
+    data$x <- NULL
+    data$y <- NULL
+    d <- tidyr::gather_(data, "variable", "x", c("x1", "x2", "xend"))
+    d$y <- tidyr::gather_(data, "variable", "y", c("y1", "y2", "yend"))$y
+    d <- d[order(d$group), ]
+    prefix_class(d, "GeomPolygon")
+  }
+  
+  # Every row is one segment, we convert to a line with several
+  # groups which can be efficiently drawn by adding NA rows.
+  #browser()
+  #data$group <- seq_len(nrow(data))
+  #others <- data[!names(data) %in% c("x", "y", "xend", "yend")]
+  #data <- with(data, {
+  #  rbind(cbind(x, y, others),
+  #        cbind(x = xend, y = yend, others))
+  #})
+  #
+  #prefix_class(data, "GeomPath")
+}
+
 #' @export
 to_basic.GeomRect <- function(data, prestats_data, layout, params, ...) {
   data$group <- seq_len(nrow(data))