如何在带有ggplotly（）的闪亮应用程序中使用plotlyProxy（）以使绘图更快地渲染

Question

如何在带有ggplotly（）的闪亮应用程序中使用plotlyProxy（）以使绘图更快地渲染

我一直在寻找一个与此相关的问题，但是我还没有看到任何问题ggplotly()。该图基于用户selectInput()下拉菜单是反应式的。一切正常，但是当我单击下拉菜单中的新参数时，绘制图形需要很长时间。通过调查，我发现了这篇文章，“ 改进ggplotly转换”，这解释了为什么绘图需要很长时间才能呈现（我有很多数据）。在网站上说使用plotlyProxy()。但是，我很难将其实现到我的代码中。更具体地说，我不了解如何使用plotlyProxyInvoke()必须与之配合使用的功能。我将不胜感激任何指导！

样本数据：

  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"))

Run Code Online (Sandbox Code Playgroud)

用户界面

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)

Run Code Online (Sandbox Code Playgroud)

服务器：

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)

Run Code Online (Sandbox Code Playgroud)

我实际使用的数据超过300,000个观察值，并且该应用程序要复杂得多。.但是我将使用它来使其简短而优美。我希望这足以作为一个可重复的示例。如果没有，请告诉我！

Answer 1

SeG*_*eGa 7

下图为shinyApp如何使用plotlyProxyInvoke与方法relayout，restyle，addTraces，deleteTraces和moveTraces。

您并没有真正拥有 plotly 对象，因为您没有将 ggplot 对象包装在ggplotly调用中。我也包括了这个highlight_key函数，尽管这个例子并不是真的需要它。

重新布局500.你可以找到一个票友重新布局法-当你在例如放大，这将改变标题和yaxis.range 0发生在这里。
当您单击橙色点时，会发生Restyle 1方法，这会将不透明度更改为 0.1，将标记颜色更改为蓝色，将线条颜色更改为橙色。

Restyle 2在您使用 Box/Lasso-Select 时发生，这会将不透明度更改回 1，将标记颜色更改为红色，将线条颜色更改为蓝色。

AddTraces在悬停在该点（或附加轨迹）上时发生，这将添加随机轨迹。

DeleteTraces发生在按钮单击 ( delete) 时，这将删除数据数组中的最后一个跟踪。

MoveTraces发生在按钮单击 ( move) 时，这将更改索引为 0 和 1 的轨迹的顺序，并将它们附加到数据数组的末尾。

要查看可以调用的所有可用方法，请输入：

plotly:::plotlyjs_methods() [1] "restyle" "relayout" "update" "addTraces" "deleteTraces" "moveTraces" "extendTraces" "prependTraces" [9] "purge" "toImage" "downloadImage" "animate"
Run Code Online (Sandbox Code Playgroud)
如需进一步解释，请查看Plotly 参考和这个ShinyApp-example。

用户界面

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)
Run Code Online (Sandbox Code Playgroud)
服务器

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)
Run Code Online (Sandbox Code Playgroud)

归档时间：	6 年，11 月前
查看次数：	312 次
最近记录：	6 年，4 月前