如何在带有 ggplotly() 的闪亮应用程序中使用 plotlyProxy() 来加快绘图渲染速度
How to use plotlyProxy() in shiny app with ggplotly() to make plots render faster
我一直在寻找解决这个问题的问题，但我还没有看到任何问题。我正在创建一个闪亮的应用程序，它使用 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"))
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<- 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 个观察值，应用程序要复杂得多..但我会用它来保持简短和有趣。我希望这对于一个可重现的例子来说已经足够了。如果还不够请告诉我！
下面的 shinyApp 展示了如何将 plotlyProxyInvoke 与方法 relayout、restyle、addTraces、deleteTraces 和 moveTraces 一起使用。
您并没有真正的 object，因为您没有将 ggplot object 包装在 ggplotly 调用中。我还包含了 highlight_key 函数，尽管对于这个例子来说它并不是必需的。
例如，Relayout 会在您放大时发生，这会将标题和 yaxis.range 更改为 0 - 500。您可以找到一个发烧友 relayout-method 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 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)
我一直在寻找解决这个问题的问题，但我还没有看到任何问题。我正在创建一个闪亮的应用程序，它使用 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"))
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<- 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 个观察值，应用程序要复杂得多..但我会用它来保持简短和有趣。我希望这对于一个可重现的例子来说已经足够了。如果还不够请告诉我！
下面的 shinyApp 展示了如何将 plotlyProxyInvoke 与方法 relayout、restyle、addTraces、deleteTraces 和 moveTraces 一起使用。
您并没有真正的 object，因为您没有将 ggplot object 包装在 ggplotly 调用中。我还包含了 highlight_key 函数，尽管对于这个例子来说它并不是必需的。
-
例如，
Relayout 会在您放大时发生，这会将标题和 yaxis.range 更改为 0 - 500。您可以找到一个发烧友 relayout-method 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 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)