Gradient segment/line between points: Alternatives to ggforce geom_link2() b/c plotly doesn't work

Question

I made a ggplot with gradient line segments between points using geom_link2 from the ggforce package and it does what I want:

But when I pipe it through ggplotly() , I get this warning Warning: geom_GeomPathInterpolate() has yet to be implemented in plotly. and it prints without the lines. I tried posting on GitHub for this geom but am not sure I did it correctly. Is there another way to generate gradient lines/segments in ggplot that are ggplotly compatible? Thanks!

# Practice data


library(ggplot2)
library(plotly)
library(ggforce)

# df
data <- structure(list( Percent = c(0.32, 0.23, 0.75, 0.25, 0.482, 0.421, 0.5114, 0.3423, 0.27, 0.4324, 0.347, 0.377, 0.26, 
0.375, 0.18604, 0.241378, 0.3095, 0.348837209, 0.33333, 0.1875, 0.2820, 0.65, 0.72, 0.75, 0.81, 0.87, 0.8244), finalpoint = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, 0.8244), date = structure(c(18262, 18293, 18322, 18353, 18383, 18414, 18444, 18475, 18506, 18536, 
18567, 18597, 18628, 18659, 18687, 18718, 18748, 18779, 18809, 18840, 18871, 18901, 18932, 18962, 18993, 19024, 19052), class = "Date"),  Status_perc = structure(c(1L, 1L, 2L, 1L, 1L, 1L, 1L, 1L,  1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L,   2L, 3L, 3L, 3L), levels = c("<70%", "70-80%", "≥80%"), class = "factor")), row.names = c(NA, 
-27L), class = c("tbl_df", "tbl", "data.frame"))

# Create ggplot
test <- data %>% 
    ggplot( aes ( x = date, y = Percent,
                label = finalpoint , 
                colour= Percent, 
                group = 1)) +   # Note sure why, but I have to add this
    geom_link2(  ) +
  geom_point ( ) + 
  geom_text(aes(label = ifelse(is.na(finalpoint), "", sprintf("%1.1f%%",finalpoint*100))) , 
            nudge_y = +0.1, nudge_x = -50  ) +                # Add label for final point, formatted as %.
  scale_y_continuous(limits = c(0,1)) + 
  scale_colour_gradient2(low = "red", mid = "yellow" , high = "green", 
                         midpoint= 0.70,
                         limits = c(0,1)) 


test

test %>% plotly::ggplotly( ) %>%
#  tooltip =  c("Percent", "edtriage", "Num_Denom" , ")) %>%
  config(displayModeBar = F) 

Answer 1

I tried a ton of different ways that capitalized on ggplot . There are a few issues with achieving this objective.

Plotly doesn't support gradient lines. However, you could plot a mass of points along a line and give that a gradient. However, Plotly will naturally combine 2 traces with points (markers in Plotly) that have the same color scheme, which equates to the points being the same size.

Another issue with creating the ggplotly object and modifying it is that date axes are converted to string data between ggplot and Plotly. ggplot has to because of grid . Whereas Plotly keeps dates as dates because it uses JS.

I think the easiest approach is to avoid ggplot in this case.

Creating points along a line.

There are two functions here. One is for finding the midpoint of the midpoint...of the midpoint qty number of times. The second calls the first function for each of the axes.

Then I use lapply to loop through every row and leading row that create a line segment to send to these functions.

queue <- function(x1, x2, qty) { # find midpoints
  # x or y axis endpoints of a line seqment, qty of points to identify
  q = list()
  q[[1]] <- c(1, qty)    # index in R starts at 1
  pts = matrix(0, qty)   # create an matrix with exactly qty positions
  pts[1] = x1; pts[qty] = x2
  while(length(q) != 0) {
    left = q[[1]][1]
    right = q[[1]][2]
    q[[1]] <- NULL # remove working segment
    center = floor((left + right)/2)         # find index midpoint
    pts[center] = (pts[left] + pts[right])/2 # assign values to specific indicies
    if(right - left > 2){
      q[[length(q) + 1]] = c(left, center)
      q[[length(q) + 1]] = c(center, right)
    }
  }
  return(pts)
}

collector <- function(x1, x2, y1, y2, qty) {
  # line segments xs and ys, qty of points to plot
  ptx = queue(x1, x2, qty)
  pty = queue(y1, y2, qty)
  return(list(ptx, pty)) # return x, y points that make up line segment
}

# convert for points along line
dt <- data$date %>% as.POSIXlt() %>% as.numeric()

newx = vector(mode = "integer")
newy = vector(mode = "double")
invisible(lapply(
  seq(1, nrow(data) - 1),
  function(j) {
    values = collector(dt[j], dt[j + 1], 
                       data$Percent[j], data$Percent[j + 1], 500)
    newx <<- append(newx, values[[1]])
    newy <<- append(newy, values[[2]])
  }
))

Because the data dates are as.Date which doesn't have time, both the data and newx need to be converted to equivalent time formats. To have points in any abundance along a time axis, you'll need to include time.

#-------------- Prepare for Plotly --------------
newx3 <- newx %>% as.POSIXct(origin = "1970-01-01 UTC")
data3 <- data %>% mutate(date = as.POSIXct(date))

When you run that code, it will look like it's in your timezone. However, when Plotly runs it, it will run as UTC. In other words, the dates will show exactly as you had originally defined them.

It's time to plot.

For the first plot, we'll use data3 . In plotly geom_point equates to type = "scatter", mode = "markers" . We'll use something called coloraxis , so that all data in the plot uses the same color scheme.

Additionally, since you'll have hover content, I've formatted the percentages as percentages in the hovertemplate .

Instead of calling your label as it's own layer ( ggplot ) or trace ( plotly ), we'll add it is a single label or annotation .

We'll define the range of the x-axis, because we used POSIX . Because we set coloraxis in the call for plot_ly , we have to define what that means in layout . I used the palette "Hot" , but you can use any color palette. Additionally, I applied some settings to the colorbar so it would more closely align with the appearance in ggplot .

fig <- plot_ly(data3, x = ~date, y = ~Percent,
        hovertemplate = "Date: %{x}<br>Percentage: %{y:.0%}<extra></extra>",
        marker = list(color = ~Percent, coloraxis = "coloraxis"),
        type = "scatter", mode = "markers") %>% 
  layout(xaxis = list(range = range(data3$date)),
         hoverdistance = -1,
         annotations = list(
           showarrow = T, x = data3[nrow(data3), ]$date, 
           y = data3[nrow(data3), ]$Percent, text = "82.44%", yshift = 1,
           xanchor = "center", yanchor = "middle", 
           ax = 20, ay = -30),
         coloraxis = list(
           colorscale = "Hot", cmid = .7,
           colorbar = list(title = "", tick0 = 0, dtick = .25,
                           outlinewidth = 0, thickness = 20,
                           len = .5)))

Next, we'll plot the points that will replace the lines. We still need to assign coloraxis , but there's no need to assign a layout at all. When we combine these two plots, we'll use the layout from the first plot.

I've removed hover data from this figure since the points in fig are the relevant points.

fig2 <- plot_ly(x = newx3, y = newy, hoverinfo = "skip",
                type = 'scatter', mode = 'markers', showlegend = F,
                marker = list(color = ~newy, coloraxis = "coloraxis",
                             size = 2.5)) 

These plots need to be complete Plotly objects so that we can extract the data from fig2 and put it in fig .

fig <- plotly_build(fig)
fig2 <- plotly_build(fig2)
fig$x$data <- list(fig$x$data[[1]], fig2$x$data[[1]])
fig # done!