There are two main bottlenecks here. First is the initial rendering of the line with 1 million points and the second is the 'update' to zoom in on a time series. It's not entirely clear how best to address the initial draw (it depends on the context of your problem), but you could certainly speed up of the update via plotlyProxy(). Similar to leaflet::leafletProxy(), this function allows you to a partially update a plotly graph in shiny (instead of doing a full redraw). Currently the best place to read about plotlyProxy() is here, but I'll be adding a section to the plotly book fairly soon.
Here is how I would implement the 'partial update' you need, which is actually somewhat similar to this example -- https://github.com/ropensci/plotly/blob/master/inst/examples/shiny/proxy_relayout/app.R
library(ggplot2)
library(plotly)
library(shiny)
ui <- fluidPage(
plotlyOutput("plot1"),
plotlyOutput("plot2")
)
range2 <- 1000000
p1x <- runif(10)
p1y <- runif(10)
p1t <- runif(10)*range2
times <- seq(1, range2)
ys <- runif(range2)
plot2xlim <- c(1000,2000)
server <- function(input, output, session) {
# make plotly plot
output$plot1 <- renderPlotly({
g <- ggplot()+geom_point(aes(x=p1x,y=p1y))
ggplotly(g)
})
output$plot2 <- renderPlotly({
plot_ly() %>%
add_lines(x = times, y = ys, size = I(1), color = I("blue")) %>%
toWebGL()
})
observeEvent(event_data("plotly_click"), {
selpoint <- event_data("plotly_click")$pointNumber[1] + 1
plot2xlim <- c(p1t[selpoint]-500,p1t[selpoint]+500)
plotlyProxy("plot2", session) %>%
plotlyProxyInvoke("relayout", list(xaxis = list(range = plot2xlim)))
})
}
shinyApp(ui, server)
If you really need to draw everything by default, plotlyProxy() will help you update the range quickly, but rendering a 1M time series probably isn't the best way to go about it. One option is to select one of these points by default (and provide a visual clue that the series is selection in the scatterplot)
library(ggplot2)
library(plotly)
library(shiny)
ui <- fluidPage(
plotlyOutput("plot1"),
plotlyOutput("plot2")
)
range2 <- 1000000
pts <- data.frame(
x = runif(10),
y = runif(10),
t = runif(10) * range2,
id = seq_len(10)
)
lines <- data.frame(
x = seq_len(range2),
y = runif(range2)
)
plot2xlim <- c(1000, 2000)
server <- function(input, output, session) {
# keep track of selection id/key
selection <- reactiveVal(1)
observeEvent(event_data("plotly_click"), {
d <- event_data("plotly_click")
if (!is.null(d$key)) selection(d$key)
})
output$plot1 <- renderPlotly({
plot_ly(showlegend = FALSE) %>%
add_markers(data = pts, x = ~x, y = ~y, key = ~id, color = I("black")) %>%
add_markers(data = pts[pts$id %in% selection(), ], x = ~x, y = ~y, color = I("blue"))
})
output$plot2 <- renderPlotly({
rng <- pts[pts$id %in% selection(), ]$t
idx <- rng + 500 >= lines$x & lines$x >= rng - 500
plot_ly() %>%
add_lines(data = lines[idx, ], x = ~x, y = ~y, size = I(1), color = I("blue")) %>%
toWebGL()
})
}
shinyApp(ui, server)