How to use plotlyProxy() in shiny app with ggplotly() to make plots render faster

Question

I have been looking for a question that deals with this but I haven't seen any.. I am creating a shiny app which uses ggplotly() to make my graph interactive. The graph is reactive based on a user selectInput() drop down menu. Everything works fine but when I click a new parameter in the drop down menu, it takes a long time for the plot to render. From looking into this I found this article,Improving ggplotly conversions,that explains why the plot takes a long time to render(I have a lot of data). On the website it says to use plotlyProxy(). However, I am having a difficult time trying to implement this into my code. More specifically, I don't understand how to use the plotlyProxyInvoke() function that you must use with it. I would greatly appreciate any guidance!

Sample data:

  df<-structure(list(stdate = structure(c(17694, 14581, 14162, 14222, 
    17368, 16134, 17414, 13572, 17613, 15903, 14019, 12457, 15424, 
    13802, 12655, 14019, 16143, 17191, 13903, 12362, 12929, 13557, 
    16758, 13025, 15493, 16674, 15959, 15190, 16386, 11515, 12640, 
    15295, 15664, 15145, 17077, 14914, 14395, 14992, 13271, 12730
    ), class = "Date"), sttime = structure(c(35460, 42360, 32880, 
    30600, 26760, 45000, 36000, 32700, 39000, 35460, 34200, 28800, 
    26400, 33900, 39600, 29280, 34500, 28920, 31320, 34800, 37800, 
    42000, 34560, 27000, 35280, 37800, 36000, 32940, 30240, 42900, 
    28800, 35100, 35400, 39600, 30420, 41100, 34500, 32040, 37800, 
    36000), class = c("hms", "difftime"), units = "secs"), locid = c("BTMUA-SB1", 
    "BTMUA-INTAKE", "BTMUA-SA", "USGS-01394500", "BTMUA-NA", "USGS-01367785", 
    "NJDEP_BFBM-01411461", "BTMUA-SD", "NJDEP_BFBM-01443293", "BTMUA-SL", 
    "USGS-01396660", "USGS-01390400", "BTMUA-SA", "21NJDEP1-01407670", 
    "USGS-01477440", "BTMUA-NA", "BTMUA-SA", "BTMUA-SE", "BTMUA-SA", 
    "USGS-01405340", "USGS-01444990", "BTMUA-SG", "BTMUA-SB1", "USGS-01467359", 
    "BTMUA-SA", "USGS-01382000", "USGS-01412800", "BTMUA-NA", "BTMUA-SI", 
    "31DRBCSP-DRBCNJ0036", "21NJDEP1-01410230", "USGS-01465861", 
    "BTMUA-NF", "USGS-01445210", "BTMUA-NA", "USGS-01464020", "BTMUA-SL", 
    "BTMUA-SA", "USGS-01382500", "USGS-01408598"), charnam = c("Total dissolved solids", 
    "Total dissolved solids", "Total dissolved solids", "Total dissolved solids", 
    "Total dissolved solids", "Total dissolved solids", "Total dissolved solids", 
    "Total dissolved solids", "Total dissolved solids", "Total dissolved solids", 
    "Total dissolved solids", "Total dissolved solids", "Total dissolved solids", 
    "Total dissolved solids", "Total dissolved solids", "Total dissolved solids", 
    "Total dissolved solids", "Total dissolved solids", "Total dissolved solids", 
    "Total dissolved solids", "Total dissolved solids", "Total dissolved solids", 
    "Total dissolved solids", "Total dissolved solids", "Total dissolved solids", 
    "Total dissolved solids", "Total dissolved solids", "Total dissolved solids", 
    "Total dissolved solids", "Total dissolved solids", "Total dissolved solids", 
    "Total dissolved solids", "Total dissolved solids", "Total dissolved solids", 
    "Total dissolved solids", "Total dissolved solids", "Total dissolved solids", 
    "Total dissolved solids", "Total dissolved solids", "Total dissolved solids"
    ), val = c(126, 84, 97, 392, 185, 157, 62, 149.4, 274, 60, 134, 
    516, 121, 144, 143, 99, 154, 120, 96, 99, 278, 96.2, 135, 101, 
    110, 460, 147, 117, 102, 250, 75, 121, 129, 242, 172, 279, 51, 
    205, 88, 38), valunit = c("mg/l", "mg/l", "mg/l", "mg/l", "mg/l", 
    "mg/l", "mg/l", "mg/l", "mg/l", "mg/l", "mg/l", "mg/l", "mg/l", 
    "mg/l", "mg/l", "mg/l", "mg/l", "mg/l", "mg/l", "mg/l", "mg/l", 
    "mg/l", "mg/l", "mg/l", "mg/l", "mg/l", "mg/l", "mg/l", "mg/l", 
    "mg/l", "mg/l", "mg/l", "mg/l", "mg/l", "mg/l", "mg/l", "mg/l", 
    "mg/l", "mg/l", "mg/l"), HUC14 = c("02040301030050", "02040301040020", 
    "02040301030050", "02030104050040", "02040301020050", "02020007020030", 
    "02040206130020", "02040301030050", "02040105040040", "02040301030010", 
    "02030105020030", "02030103140040", "02040301030050", "02030104090040", 
    "02040202160010", "02040301020050", "02040301030050", "02040301030040", 
    "02040301030050", "02030105140020", "02040105070040", "02040301030040", 
    "02040301030050", "02040202120010", "02040301030050", "02030103040010", 
    "02040206080040", "02040301020050", "02040301030030", "02040105050050", 
    "02040301200110", "02040202060040", "02040301020020", "02040105080020", 
    "02040301020050", "02040105240060", "02040301030010", "02040301030050", 
    "02030103050060", "02040301080050"), WMA = c("13", "13", "13", 
    "7", "13", "2", "17", "13", "1", "13", "8", "4", "13", "12", 
    "18", "13", "13", "13", "13", "9", "1", "13", "13", "18", "13", 
    "6", "17", "13", "13", "1", "14", "19", "13", "1", "13", "11", 
    "13", "13", "3", "13"), year = c(2018L, 2009L, 2008L, 2008L, 
    2017L, 2014L, 2017L, 2007L, 2018L, 2013L, 2008L, 2004L, 2012L, 
    2007L, 2004L, 2008L, 2014L, 2017L, 2008L, 2003L, 2005L, 2007L, 
    2015L, 2005L, 2012L, 2015L, 2013L, 2011L, 2014L, 2001L, 2004L, 
    2011L, 2012L, 2011L, 2016L, 2010L, 2009L, 2011L, 2006L, 2004L
    )), .Names = c("stdate", "sttime", "locid", "charnam", "val", 
    "valunit", "HUC14", "WMA", "year"), row.names = c(NA, -40L), class = c("tbl_df", 
    "tbl", "data.frame"))

UI

library(shiny)
library(shinydashboard)
library(tidyverse)
library(plotly)

header<-dashboardHeader(title="test app")
sidebar<-dashboardSidebar(selectInput("huc","Please Select HUC14:",choices=df$HUC14,selected = df$HUC14))
body<- dashboardBody(plotlyOutput("plot"))

ui <- dashboardPage(header = header,
                   sidebar = sidebar,
                   body = body)

Server:

server<- function(input,output,session) {
  df_reac<-reactive({
    df%>%
      filter(HUC14 == input$huc)
  })

  output$plot<-renderPlotly({
    ggplot(df_reac(), aes(x = year, y = val)) +
      geom_point(aes(color="Discrete"),size=3) +
      geom_hline(aes(yintercept = 500,color="Freshwater Aquatic Life Criteria\nfor TDS = 500 mg/L"),size=1.3)+
      xlab("Year") + ylab(" TDS Concentration (mg/L)")})


  observeEvent(input$huc,{
    plotlyProxy("plot",session)%>%
      plotlyProxyInvoke("relayout")
  })
}

shinyApp(ui,server)

The data I'm actually using is over 300,000 observations and the app is a lot more complex.. but I will use this to keep it short and sweet. I hope this is enough for a reproducible example.. if not please let me know!

Answer 1

The shinyApp below shows how to use plotlyProxyInvoke with the methods relayout, restyle, addTraces, deleteTraces and moveTraces.

You didn't really have a plotly object, as you didnt wrap the ggplot object inside a ggplotly call. I also included the highlight_key function, although it is not really necessary for this example.

• Relayout happens when you zoom in for example, which will change the Title and the yaxis.range to 0 - 500. You can find a fancier relayout-method here.

• Restyle 1 method happens when you click on the orange point, which will change the opacity to 0.1, the marker color to blue and the line color to orange.

• Restyle 2 happens when you use the Box/Lasso-Select, which will change the opacity back to 1, the marker color to red and the line color to blue.

• AddTraces happens when hovering over the point (or the additional traces), which will add a random trace.

• DeleteTraces happens upon button click (delete), which will remove the last trace in the data array.

• MoveTraces happens upon button click (move), which will change the ordering of the traces with index 0 & 1 and appends them to the end of the data array.

To see all available methods that can be invoked, enter:

plotly:::plotlyjs_methods()

[1] "restyle"       "relayout"      "update"        "addTraces"     "deleteTraces"  "moveTraces"    "extendTraces"  "prependTraces"               
[9] "purge"         "toImage"       "downloadImage" "animate"

For further explanation, check out the Plotly reference and this shinyApp-example.

---

ui.R

library(shiny)
library(shinydashboard)
library(tidyverse)
library(plotly)

header<-dashboardHeader(title="test app")
sidebar<-dashboardSidebar(selectInput("huc","Please Select HUC14:",choices=df$HUC14,selected = df$HUC14),
                          actionButton("delete", "Delete the last trace"),
                          actionButton("move", " Move traces"))
body<- dashboardBody(plotlyOutput("plot"))

ui <- dashboardPage(header = header,
                   sidebar = sidebar,
                   body = body)

server.R

server<- function(input,output,session) {
  df_reac<-reactive({
    df%>%
      filter(HUC14 == input$huc)
  })

  output$plot<-renderPlotly({
    key = highlight_key(df_reac())
    p <- ggplot(key, aes(x = year, y = val)) +
      geom_point(aes(color="Discrete"),size=3) +
      geom_hline(aes(yintercept = 500,color="Freshwater Aquatic Life Criteria\nfor TDS = 500 mg/L"),size=1.3)+
      xlab("Year") + ylab(" TDS Concentration (mg/L)")

    ggplotly(p)
  })

  observeEvent(event_data("plotly_relayout"), {
    print("relayout")
    plotlyProxy("plot", session) %>%
      plotlyProxyInvoke("relayout", list(title = 'New title', 
                                         yaxis.range = list(0,500)))
  })

  observeEvent(event_data("plotly_click"), {
    print("restyle 1")
    plotlyProxy("plot", session) %>%
      plotlyProxyInvoke("restyle", list(opacity=0.1, marker.color="blue", line.color="orange"))
  })

  observeEvent(event_data("plotly_selected"), {
    print("restyle 2")
    plotlyProxy("plot", session) %>%
      plotlyProxyInvoke("restyle", list(opacity=1, marker.color="red", line.color="blue"))
  })

  observeEvent(event_data("plotly_hover"), {
    print("addTraces")
    time = as.numeric(format(df_reac()$stdate, "%Y"))
    plotlyProxy("plot", session) %>%
      plotlyProxyInvoke("addTraces", list(y = as.list(sort(sample(100:500, 3, F))), 
                                          x = as.list(sort(sample(seq(time-0.05,time+0.05, by = 0.02), 3, F)))))
  })

  observeEvent(input$delete, {
    print("deleteTraces")
    plotlyProxy("plot", session) %>%
      plotlyProxyInvoke("deleteTraces", list(-1))
  })

  observeEvent(input$move, {
    print("moveTraces")
    plotlyProxy("plot", session) %>%
      plotlyProxyInvoke("moveTraces", list(0, 1))
  }) 

}

shinyApp(ui,server)