如何在带有 ggplotly() 的闪亮应用程序中使用 plotlyProxy() 以使绘图渲染得更快
Posted
技术标签:
【中文标题】如何在带有 ggplotly() 的闪亮应用程序中使用 plotlyProxy() 以使绘图渲染得更快【英文标题】：How to use plotlyProxy() in shiny app with ggplotly() to make plots render faster 【发布时间】：2019-05-05 23:31:37 【问题描述】：我一直在寻找一个可以解决这个问题的问题，但我没有看到任何问题。我正在创建一个闪亮的应用程序，它使用ggplotly() 来使我的图表具有交互性。该图是基于用户selectInput() 下拉菜单的反应性图表。一切正常，但是当我单击下拉菜单中的新参数时，绘图需要很长时间才能渲染。通过调查，我发现了这篇文章，Improving ggplotly conversions，这解释了为什么该图需要很长时间才能渲染（我有很多数据）。在网站上说使用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"))
用户界面
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<- 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)
我实际使用的数据是超过 300,000 次观察，应用程序要复杂得多。但我会用它来保持简短和甜蜜。我希望这对于一个可重复的例子来说已经足够了。如果没有，请告诉我！
【问题讨论】：
【参考方案1】：下面的 shinyApp 展示了如何使用 plotlyProxyInvoke 和 relayout、restyle、addTraces、deleteTraces 和 moveTraces 方法。
您实际上并没有一个 plotly 对象，因为您没有将 ggplot 对象包装在 ggplotly 调用中。我还包含了highlight_key 函数，尽管在本示例中它并不是必需的。
Relayout 会在您放大时发生，例如，这会将 Title 和 yaxis.range 更改为 0 - 500。您可以找到更高级的重新布局方法 here。
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"
如需进一步说明，请查看Plotly reference 和此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)
服务器.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)
【讨论】：
感谢您的回答.. 对不起，我什至没有意识到我没有 ggplotly 电话，我在我的真实应用程序中这样做了.. 不过我有点困惑。我必须有两个操作按钮吗？我的真实应用程序非常复杂，我真的不想向它添加更多小部件。我只是想让绘图渲染得更快，因为我有数百万个数据点。 有没有办法将其链接到 HUC 下拉菜单？？ 是的，当然，这只是不同方法的说明。您当然可以将input$move 更改为input$huc。我不明白你到底想在代理方法中做什么，所以我只是展示了一些例子。以上是关于如何在带有 ggplotly() 的闪亮应用程序中使用 plotlyProxy() 以使绘图渲染得更快的主要内容，如果未能解决你的问题，请参考以下文章
ggplotly 和 shinydashboard 框的布局问题