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!

SeGa · Accepted Answer · 2019-06-23T19:21:04.520

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)

Thank you for your answer.. sorry I didn't even realize that I didn't have the ggplotly call, I do in my real app.. I am a little confused though. Do I have to have the two action buttons? My real app is very complex and I don't really want to add more widgets to it. I just want the plot to render faster because I have millions of data points. — NBE, Dec 19 '18 at 13:56
Is there a way to have it linked to the HUC drop down menu?? — NBE, Dec 19 '18 at 14:10
Yes of course, this is just an illustration of different methods. You can certainly change `input$move` to `input$huc`. I didnt understand what exactly you want to do in the proxy method so I just showed some examples. — SeGa, Dec 19 '18 at 14:42

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

1 Answers1