Как улучшить скорость гистограммы ggplot при построении> 1000 точек?

ProgramBox

Как улучшить скорость гистограммы ggplot при построении> 1000 точек?

Post author:admin
Запись опубликована:27 ноября, 2022
Post category:Вопросы по программированию

#r #performance #ggplot2 #r-markdown #geom-bar

#r #Производительность #ggplot2 #r-markdown #геометрическая панель

Вопрос:

Я создаю гистограмму для 1200 наблюдений, используя ggplot2. Каждое из этих наблюдений имеет полосу ошибок. Также показано среднее значение (с использованием geom_line) для этих наблюдений в целом.

Я обнаружил, что время выполнения очень медленное (2 секунды) по сравнению с меньшим количеством наблюдений (например, если 500 или использовались <1 секунды). Кроме того, все наблюдения должны быть отдельной строкой.

Я понимаю, что это звучит не так много времени, но это время в целом подходит для того, что мне нужно сделать — создать более 100 таких графиков и связать их с файлом rmd.

Ниже приведен фрагмент кода, который я создал для воспроизведения проблемы — для этого используется встроенный набор данных diamonds 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" amp; 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 за меньшее общее время.

Как я могу сократить время, необходимое для построения графика из фрагмента кода?

Любая помощь или указание в правильном направлении приветствуется.

1. В моей системе тоже занимает 2 секунды. R-способ сравнительного system.time({ ... }) анализа, есть также microbenchmark библиотека и github.com/rstudio/profvis . Я прогнал ваш код profvis , хотя и не знаю, как ускорить время выполнения. Вам понадобится явный код print(DiamondCutChart)

Ответ №1:

На данный момент я предполагаю, что вы стремитесь к необработанной скорости и визуализации, которая отображает желаемое содержимое данных. Я не уверен, что вам нужно geom_bar() , если только один столбик другого цвета. Если в вашем реальном сценарии 7 разных цветов случайным образом перемешаны между 1255 столбцами … этот обходной путь вам не подойдет. 🙂 Надеюсь, это будет полезно! 🙂

Визуализация geom_ribbon() намного быстрее, чем geom_bar() . С 1255 позициями я не возился с его опциями, но я понимаю, что у него есть пошаговые функции, чтобы при увеличении они выглядели как столбцы. Ymmv.

Это настолько быстрее, что я решил использовать его дважды: один раз для отображения «баров» и один раз для отображения «баров ошибок». Для того geom_ribbon() , чтобы работать (для меня) Я создал числовой столбец для значений по оси x Xval , см. Ниже.

На geom_text() самом деле на этом шаге печатается только одна метка, и установка подмножества data на этом шаге экономит много времени рендеринга. Вы можете настроить по мере необходимости.

То же самое с annotate() шагом, на самом деле это печать и повторная печать одной и той же метки 1255 раз, занимает много времени. Очевидно, вам это не нужно. 🙂

Каждый из трех описанных выше шагов экономит от 0,6 до 0,7 секунды. Возможно, вы можете смешивать и сопоставлять с другими геометрическими фигурами по мере необходимости.

Конечный результат (в моей системе) составил 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

1. Большое вам спасибо — это значительно ускоряет работу. Я тоже никогда не знал о geom_col. Однако я не совсем уверен, как добавить заливку в geom_col, чтобы она выделяла и другие подобные столбцы. Я обновил код в своем первоначальном вопросе, чтобы отразить это — теперь он имеет 3 значения scale_fill_manual. Я не совсем уверен, как включить это в любезно предоставленный вами код? Также мне потребуется легенда, чтобы показать эти 3 цвета.

2. В моем тестировании geom_col() был даже медленнее, чем geom_bar(), понятия не имею, почему. Он также отображался немного по-другому, но более или менее совместим. Это что-то вроде этого: geom_col(aes(x=Xval, y=x, fill=CutLabel)) но я рекомендую делать data=subset(...) так, чтобы вы отображали столбцы только с выделением цветов.

Ответ №2:

Вставка прогона 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
)

Метки: Как улучшить скорость гистограммы ggplot при построении> 1000 точек?