Улучшение производительности ggplotly при построении карты временного ряда

Question

Я создаю интерактивную тепловую карту временных рядов в R , используя Plotly и Shiny. В рамках этого процесса я перекодирую значения тепловой карты из непрерывного в порядковый формат - поэтому у меня есть тепловая карта, в которой шесть цветов представляют определенные категории c, и эти категории создаются из агрегированных значений счетчиков. Однако это вызывает серьезную проблему с производительностью при скорости создания карты температур с использованием ggplotly(). Я проследил это до функции tooltip() от Plotly, которая отображает интерактивные блоки. Данные меток из моей тепловой карты каким-то образом перегружают эту функцию так, что она работает очень медленно, даже если я просто добавляю один компонент меток к tooltip(). Я использую обработанное подмножество данных о вспышках COVID-19 из хранилища Джонса Хопкинса CSSE . Вот упрощенный код тепловой карты, в котором также используется цветовая тема Simpsons из ggsci:

#Load packages
library(shiny)
library(plotly)
library(tidyverse)
library(RCurl)
library(ggsci)

#Read example data from Gist
confirmed <- read_csv("https://gist.githubusercontent.com/GeekOnAcid/5638e37c688c257b1c381a15e3fb531a/raw/80ba9704417c61298ca6919343505725b8b162a5/covid_selected_europe_subset.csv")

#Wrap ggplot of time-series heatmap in ggplotly, call "tooltip"  
ggplot_ts_heatmap <- confirmed %>%
  ggplot(aes(as.factor(date), reorder(`Country/Region`,`cases count`), 
             fill=cnt.cat, label = `cases count`, label2 = as.factor(date), 
             text = paste("country:", `Country/Region`))) + 
  geom_tile(col=1) +
  theme_bw(base_line_size = 0, base_rect_size = 0, base_size = 10) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),legend.title = element_blank()) +
  scale_fill_manual(labels = levels(confirmed$cnt.cat),
                    values = pal_simpsons("springfield")(7)) +
  labs(x = "", y = "")
ggplotly(ggplot_ts_heatmap, tooltip = c("text","label","label2"))

Производительность улучшается после уменьшения tooltip = c("text","label","label2") (например, до tooltip = c("text")) , Теперь я знаю, что задержка не является «массовой», но я интегрирую ее с приложением Shiny. И как только он интегрируется с Shiny и масштабируется с большим количеством данных, это действительно очень медленно. Я даже не показываю все переменные в tooltip, и они все еще медленны - вы можете увидеть их в текущей версии приложения , когда вы нажимаете «подтвержденные» случаи.

Есть предложения? Я рассмотрел альтернативные интерактивные пакеты тепловых карт, такие как d3heatmap, heatmaply и shinyHeatmaply, но все эти решения больше предназначены для корреляционных тепловых карт, и они Отсутствие параметров настройки ggplot.

Answer 1

Если вы переписываете его как «чистый» сюжет (без преобразования ggplotly), это будет намного быстрее. Около 3000 раз даже. Вот результат очень маленького теста:

Unit: milliseconds
 expr       min        lq       mean     median        uq       max neval
    a 9929.8299 9929.8299 9932.49130 9932.49130 9935.1527 9935.1527     2
    b    3.1396    3.1396    3.15665    3.15665    3.1737    3.1737     2

Причина, по которой ggplotly намного медленнее, заключается в том, что он не распознает входные данные как тепловую карту и создает диаграмму рассеяния, где каждый прямоугольник рисуется отдельно со всеми необходимые атрибуты. Вы можете посмотреть на результат JSON, если обернуть результат ggplotly или plot_ly в plotly_json().

. Вы также можете проверить object.size графиков, где вы увидите, что объект ggplotly имеет размер 4616,4 КБ , а карта plotly - просто 40,4 КБ большая.

df_colors = data.frame(range=c(0:13), colors=c(0:13))
color_s <- setNames(data.frame(df_colors$range, df_colors$colors), NULL)
for (i in 1:14) {
  color_s[[2]][[i]] <- pal_simpsons("springfield")(13)[[(i + 1) / 2]]
  color_s[[1]][[i]] <-  i / 14 - (i %% 2) / 14
}

plot_ly(data = confirmed, text = text) %>%
  plotly::add_heatmap(x = ~as.factor(date), 
                      y = ~reorder(`Country/Region`, `cases count`),
                      z = ~as.numeric(factor(confirmed$`cnt.cat`, ordered = T, 
                                             levels = unique(confirmed$`cnt.cat`))),
                      xgap = 0.5,
                      ygap = 0.5,
                      colorscale = color_s,
                      colorbar = list(tickmode='array',
                                      title = "Cases",
                                      tickvals=c(1:7),
                                      ticktext=levels(factor(x = confirmed$`cnt.cat`,
                                                             levels = unique(confirmed$`cnt.cat`),
                                                             ordered = TRUE)), len=0.5),
                      text = ~paste0("country: ", `Country/Region`, "<br>",
                                    "Number of cases: ", `cases count`, "<br>",
                                    "Category:  ", `cnt.cat`),
                      hoverinfo ="text"
  ) %>% 
  layout(plot_bgcolor='black',
         xaxis = list(title = ""),
         yaxis = list(title = ""));