绘制> 1000点时如何提高ggplot条形图的速度？

Question

我正在使用 ggplot2 为 1200 个观测值生成条形图。这些观察结果中的每一个都有一个误差条。还显示了这些观察结果的总体平均值（使用 geom_line）。

我发现运行与较少的观察相比（例如，如果 500 或使用 <1 秒）时间非常慢（2 秒）。此外，所有观察必须是单独的条。

我意识到这听起来时间不多，但这次加起来就是我需要做的事情 - 制作 100 多个这样的图并将它们编织到 rmd 文件中。

下面是我为重现该问题而创建的一段代码 - 这是使用 ggplot2 内置钻石数据集。

diamonds1 <- as.data.frame(mutate(diamonds, upper = x + 1.2, lower = x - 0.4))

diamonds2 <- diamonds1 %>%
  group_by(cut) %>%
  summarize(Mean = mean(x, na.rm=TRUE))

ChosenColorClarity <- "VVS28451"
diamonds3 <- left_join(diamonds1 ,diamonds2, by = c("cut" = "cut") ) %>%
  filter(cut == "Very Good") %>%
  mutate(ID = paste0(clarity,row_number() )) %>%
  mutate(CutType = case_when(ID==ChosenColorClarity ~ ID, 
                             color == "F" & ID != ChosenColorClarity ~ " Same Color",
                                                                 TRUE ~ "  Other Color"),
         CutLabel = ifelse(ID == ChosenColorClarity, "Your Cut", ""))

diamonds4 <- diamonds3[order(-xtfrm(diamonds3$CutLabel)),]
diamonds4 <- diamonds4[1:1255,]

diamonds4$Xval <- as.numeric(reorder(diamonds4$ID, diamonds4$x))

DiamondCutChart = diamonds4 %>% 
  ggplot(aes(x = Xval, 
             y = x)) + 
  geom_bar(aes(fill=CutType), stat = "identity", width = 1) +  
  geom_errorbar(aes(ymin = lower, ymax = upper)) + 
  geom_text(aes(label = CutLabel), 
            position = position_stack(vjust = 0.5), 
            size = 2.7, angle = 90, fontface = "bold") +
  geom_line(aes(y = diamonds4$Mean), group = 1, linetype=2, colour = "#0000ff") + 
  scale_fill_manual(values = c("#32572C", "#41B1B1", "#db03fc")) +
  annotate("text", x = 1, y = diamonds4$Mean, hjust =0, vjust = -0.5, 
           size = 3.2, colour = "#0000ff",
           label=paste0("Mean ",diamonds4$Mean)) +
  theme_classic()+ 
  theme(axis.title.x=element_blank(), 
        axis.title.y=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        legend.position = "top") + 
  labs(fill = "") 


StartTime = Sys.time()  
DiamondCutChart
EndTime = Sys.time()
EndTime - StartTime

当运行这个时候，大约需要2秒。我需要这个时间少于 1 秒，以便能够在更短的总时间内生成多个图和 rmarkdown 输出。

如何减少从代码段绘制图形所需的时间？

非常感谢任何帮助或指出正确的方向。

Answer 1

为这个问题粘贴 ProfVis 运行：

https://rstudio.github.io/profvis/

install.packages("profvis")
library(profvis)
profvis(expr = {
  DiamondCutChart <- diamonds4 %>% 
    ggplot(aes(x = reorder(ID, x), 
               y = x)) + 
    geom_bar(aes(fill=CutType), stat = "identity", width = 1) +  
    geom_errorbar(aes(ymin = lower, ymax = upper)) + 
    geom_text(aes(label = CutLabel), 
              position = position_stack(vjust = 0.5), 
              size = 2.7, angle = 90, fontface = "bold") +
    geom_line(aes(y = Mean), group = 1, linetype=2, colour = "#0000ff") + 
    scale_fill_manual(values = c("#32572C", "#41B1B1")) +
    annotate("text", x = 1, y = diamonds4$Mean, hjust =0, vjust = -0.5, 
             size = 3.2, colour = "#0000ff",
             label=paste0("Mean ",diamonds4$Mean)) +
    theme_classic()+ 
    theme(axis.title.x=element_blank(), 
          axis.title.y=element_blank(),
          axis.text.x=element_blank(),
          axis.ticks.x=element_blank(),
          legend.position = "top") + 
    labs(fill = "")
  print(DiamondCutChart)
  
  },
  interval = 0.005
)

Answer 2

我现在假设您的目标是原始速度和描绘所需数据内容的可视化。如果只有一个栏是不同的颜色，我不确定您是否需要 geom_bar()。如果您的真实场景在 1255 个条中随机混合了 7 种不同的颜色……此解决方法对您不起作用。 :) 希望这会有所帮助！ :)

geom_ribbon() 的渲染速度比 geom_bar() 快得多。对于 1255 个位置，我没有 fiddle 它的选项，但我知道它有阶跃函数，使它在放大时看起来像条形。Ymmv.

它快得多，我决定使用它两次：一次渲染“条形图”，一次渲染“错误条形图”。为了 geom_ribbon() 工作（对我来说），我为 x 轴值 Xval 创建了一个数字列，见下文。

geom_text()步骤实际上只打印一个标签，在此步骤中对data进行子集化可以节省大量渲染时间。您可以根据需要进行调整。

与annotate()步骤相同，实际上是将同一个标签打印再打印1255次，耗费大量时间。显然你不需要那个。 :)

以上三个步骤中的每一个都可以节省大约 0.6 到 0.7 秒。也许您可以根据需要与其他 geom 混合搭配。

最终结果（在我的系统上）是 0.2 秒。

diamonds4$Xval <- as.numeric(reorder(diamonds4$ID, diamonds4$x))

DiamondCutChartNew <- diamonds4 %>% 
   ggplot(aes(x = Xval, y = x)) + 
   geom_ribbon(aes(ymin = 0, ymax = x), fill="#32572C") +
   geom_col(data = subset(diamonds4, nchar(CutLabel) > 0),
      aes(x = Xval, y = x),
      fill = "#41B1B1") +
   geom_ribbon(data = diamonds4,
      aes(ymin = lower, ymax = upper), fill="#FF000077") +
   geom_line(aes(y = x)) +
   geom_text(data = subset(diamonds4, nchar(CutLabel) > 0),
      aes(label = CutLabel),
      position = position_stack(vjust = 0.5), 
      size = 2.7, angle = 90, fontface = "bold") +
   geom_line(aes(x = Xval, y = Mean), group = 1, linetype = 2, colour = "#0000ff") +
   annotate("text", x = 1, y = head(diamonds4$Mean, 1), hjust = 0, vjust = -0.5, 
      size = 3.2, colour = "#0000ff",
      label=paste0("Mean ", head(diamonds4$Mean, 1))) +
   theme_classic() +
   theme(axis.title.x=element_blank(),
      axis.title.y=element_blank(),
      axis.text.x=element_blank(),
      axis.ticks.x=element_blank(),
      legend.position = "top") +
   labs(fill = "") 

{StartTime = Sys.time()  
print(DiamondCutChartNew)
EndTime = Sys.time()
EndTime - StartTime}

原始结果（对我而言）： Time difference of 2.05 secs

新结果： Time difference of 0.229 secs

绘制> 1000点时如何提高ggplot条形图的速度？

How to improve speed of ggplot bar chart when plotting >1000 points?

performance

r

ggplot2

r-markdown

geom-bar