我尝试了大量不同的方法来利用ggplot。实现这个目标有一些问题。
Plotly不支持渐变线。但是，您可以沿着一条线绘制大量的点，并给予其渐变。然而，Plotly会自然地将两个轨迹与具有相同配色方案的点（Plotly中的标记）结合起来，这相当于点的大小相同。
创建和修改ggplotly对象的另一个问题是，日期轴转换为ggplot和Plotly之间的字符串数据。ggplot必须这样做，因为grid。而Plotly将日期保留为日期，因为它使用JS。
我认为最简单的方法是在这种情况下避免ggplot。

沿着创建点。

这里有两个函数，一个是求qty的中点，第二个是对每个轴调用第一个函数。
然后我使用lapply循环遍历每一行和前导行，创建一个线段发送给这些函数。

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]])
  }
))

因为数据日期是没有时间的as.Date，所以数据和newx都需要转换成等效的时间格式。要在时间轴上有任意多的点，您需要包括时间。

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

当您运行该代码时，它看起来像是在您的时区中。但是，当Plotly运行它时，它将以UTC运行。换句话说，日期将完全按照您最初定义的方式显示。

是时候开始谋划了。

对于第一个图，我们将使用data3。在图中，geom_point等于type = "scatter", mode = "markers"。我们将使用coloraxis，这样图中的所有数据都使用相同的配色方案。
此外，由于您将有悬停内容，我在hovertemplate中将百分比格式化为百分比。
我们将添加单个标签或annotation，而不是将您的标签称为它自己的图层（ggplot）或轨迹（plotly）。
我们将定义x轴的范围，因为我们使用了POSIX。因为我们在plot_ly的调用中设置了coloraxis，所以我们必须定义它在layout中的含义。我使用了调色板"Hot"，但您可以使用任何调色板。此外，我对colorbar应用了一些设置，以便它与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)))

接下来，我们将绘制将替换直线的点。我们仍然需要分配coloraxis，但根本不需要分配layout。当我们合并这两个图时，我们将使用第一个图中的布局。
由于fig中的点是相关点，因此我已经从该图中删除了悬停数据。

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

这些图需要是完整的Plotly对象，这样我们就可以从fig2中提取数据并将其放入fig中。

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