Как управлять параллельной обработкой с помощью анимированного ggplot2-plot?

Я пытаюсь построить анимированный барплот с ggplot2 а также magick это растет на основе "день в день". К сожалению, у меня есть десятки тысяч записей в моем наборе данных (даты для каждого дня в течение нескольких лет и разных категорий), что делает обработку очень медленной. Таким образом, я использую snow пакет, чтобы ускорить время обработки. Тем не менее, я столкнулся с проблемой при разделении данных и вызове ggplot() в кластере.

magick требует разделить данные по дате для анимации и snow требует разделения на кластер для параллельной обработки. Итак, я получаю список списков, который вызывает проблемы при вызове ggplot() в clusterApply(), Структура списков, конечно, зависит от последовательности, в которой я делю свои данные (см. Версии 1 и 2 в примере кода), но пока ни одна версия не привела к успеху. Я предполагаю доступ к элементам списка при использовании data$date не работает, так как в списке больше уровней.

Итак, мой вопрос: возможно ли построить анимированный график с помощью ggplot2 используя параллельную обработку таким образом?

Вот пример кода, визуализирующего мою проблему (я постарался структурировать его как можно больше):

########################################################################
# setup
########################################################################
library(parallel)
library(snow)
library(ggplot2)
library(magick)

# creating some sample data for one year
# 4 categories; each category has a specific value per day
set.seed(1)
x <- data.frame(
  rep(as.Date((Sys.Date()-364):Sys.Date(), origin="1970-01-01"),4),
  c(rep("cat01",length.out=365),
    rep("cat02",length.out=365),
    rep("cat03",length.out=365),
    rep("cat04",length.out=365)),
  sample(0:50,365*4, replace=TRUE)
)
colnames(x) <- c("date", "category", "value")
x$category <- factor(x$category)

# creating a cumulative measure making the graphs appear "growing"
x$cumsum <- NA
for(i in levels(x$category)){
  x$cumsum[x$category == i] <- cumsum(x$value[x$category == i])
}
x <- x[order(x$date),]

# number of cores
cores <- detectCores()

# clustering
cl <- makeCluster(cores, type="SOCK")

# adding a grouping-variable to the data for each cluster
x$group <- rep(1:cores, length.out = nrow(x))

########################################################################
# splitting the data
########################################################################
# V1: worker first, plotting second
# splitting data for the worker
datasplit01 <- split(x, x$group)

# splitting data for plotting
datalist01 <- clusterApply(cl, datasplit01, function(x){split(x, x$date)})

########################################################################
# V2: plotting first, worker second
# splitting data for plotting
datasplit02 <- split(x, x$date)

# splitting data for the worker
datalist02 <- clusterApply(cl, datasplit02, function(x){split(x, x$group)})

########################################################################
# conventional plotting
########################################################################
# plotting the whole data works fine
ggplot(x)+
  geom_bar(aes(category, value), stat = "identity")

########################################################################
# conventional animation with ggplot2
########################################################################
# animation per date works, but pretty slowly

# opening magick-device
img <- image_graph(1000, 700, res = 96)

# plotting 
  # replace the second line with first line if the code is too slow and if
  # you like to get an impression of what the plot should look like
# out <- lapply(datasplit02[1:50], function(data){   # line 1: downscaled dataset
out <- lapply(datasplit02, function(data){           # line 2: full dataset
  plot <- ggplot(data)+
    geom_bar(aes(category, cumsum), stat = "identity")+
    # holding breaks and limits constant per plot
    scale_y_continuous(expand = c(0,0), 
                       breaks = seq(0,max(x$cumsum)+500,500), 
                       limits = c(0,max(x$cumsum)+500))+
    ggtitle(data$date)
  print(plot)
})
dev.off()

# animation
animation <- image_animate(img, fps = 5)
animation

########################################################################
# parallel process plotting
########################################################################
# animation per date in parallel processing does not work, probably
# due to ggplot not working with a list of lists

# opening magick-device
img <- image_graph(1000, 700, res = 96)

# plotting
out <- clusterApply(cl, datalist01, function(data){
  plot <- ggplot(data)+
    geom_bar(aes(category, cumsum), stat = "identity")+
    # holding breaks and limits constant per plot
    scale_y_continuous(expand = c(0,0), 
                       breaks = seq(0,max(x$cumsum)+500,500), 
                       limits = c(0,max(x$cumsum)+500))+
    ggtitle(data$date)
  print(plot)
})
dev.off()

# animation
animation <- image_animate(img, fps = 5)
animation

Спасибо вам за ваши предложения!

ОБНОВЛЕНИЕ: используя снегопад, код намного короче, я не получаю те же ошибки, но устройство все еще не производит сюжет.

########################################################################
# snowfall version
########################################################################
library(parallel)
library(snowfall)
library(ggplot2)
library(magick)

# creating some sample data for one year
# 4 categories; each category has a specific value per day
set.seed(1)
x <- data.frame(
  rep(as.Date((Sys.Date()-364):Sys.Date(), origin="1970-01-01"),4),
  c(rep("cat01",length.out=365),
    rep("cat02",length.out=365),
    rep("cat03",length.out=365),
    rep("cat04",length.out=365)),
  sample(0:50,365*4, replace=TRUE)
)
colnames(x) <- c("date", "category", "value")
x$category <- factor(x$category)

# creating a cumulative measure making the graphs appear "growing"
x$cumsum <- NA
for(i in levels(x$category)){
  x$cumsum[x$category == i] <- cumsum(x$value[x$category == i])
}
x <- x[order(x$date),]

# number of cores
cores <- detectCores()

# clustering
sfInit(parallel = TRUE, cpus = cores, type = "SOCK")

# splitting data for plotting
datalist <- split(x, x$date)

# making everything accessible in the cluster
sfExportAll()
sfLibrary(ggplot2)
sfLibrary(magick)

# opening magick-device
img <- image_graph(1000, 700, res = 96)

# plotting
out <- sfLapply(datalist, function(data){
  plot <- ggplot(data)+
    geom_bar(aes(category, cumsum), stat = "identity")+
    # holding breaks and limits constant per plot
    scale_y_continuous(expand = c(0,0), 
                       breaks = seq(0,max(x$cumsum)+500,500), 
                       limits = c(0,max(x$cumsum)+500))+
    ggtitle(data$date)
plot
})
dev.off()

# animation
animation <- image_animate(img, fps = 5)
animation

Когда используешь

img <- image_graph(1000, 700, res = 96)
out
dev.off()
animation <- image_animate(img, fps = 5)
animation

Сюжет подготовлен. Тем не менее, призывая out очень медленно, поэтому я должен избегать этой опции, чтобы она работала.

Источник

2 ответа

Решение

Итак, мое решение:

  • разбить даты в ncores периодов

  • получить график для каждого периода и сохранить его в формате GIF

  • прочитайте все GIF и объедините их

########################################################################
# setup
########################################################################

# creating some sample data for one year
# 4 categories; each category has a specific value per day
set.seed(1)
x <- data.frame(
  rep(as.Date((Sys.Date()-364):Sys.Date(), origin="1970-01-01"),4),
  c(rep("cat01",length.out=365),
    rep("cat02",length.out=365),
    rep("cat03",length.out=365),
    rep("cat04",length.out=365)),
  sample(0:50,365*4, replace=TRUE)
)
colnames(x) <- c("date", "category", "value")

# creating a cumulative measure making the graphs appear "growing"
library(dplyr)
x <- x %>%
  as_tibble() %>%
  arrange(date) %>%
  mutate(date = as.character(date)) %>%
  group_by(category) %>%
  mutate(cumsum = cumsum(value))

y_max <- max(x$cumsum) + 500

library(doParallel)

all_dates <- unique(x$date)
ncores <- detectCores() - 1
ind_cluster <- sort(rep_len(1:ncores, length(all_dates)))
date_cluster <- split(all_dates, ind_cluster)
registerDoParallel(cl <- makeCluster(ncores))

tmp <- tempfile()

files <- foreach(ic = 1:ncores, .packages = c("tidyverse", "magick")) %dopar% {

  img <- image_graph(1000, 700, res = 96)

  x %>%
    filter(date %in% date_cluster[[ic]]) %>%
    group_by(date) %>%
    do(
      plot = ggplot(.) +
        geom_col(aes(category, cumsum)) +
        scale_y_continuous(expand = c(0, 0), 
                           breaks = seq(0, y_max, 500), 
                           limits = c(0, y_max))
    ) %>%
  pmap(function(date, plot) {
    print(plot + ggtitle(date))
    NULL
  })

  dev.off()

  image_write(image_animate(img, fps = 5), paste0(tmp, ic, ".gif"))
}
stopCluster(cl)

test <- do.call(c, lapply(files, magick::image_read))
test
Источник

Я бы сделал

library(tidyverse)
library(gganimate)
x %>% 
  as.tibble() %>% 
  arrange(date) %>%  
  group_by(category) %>% 
  mutate(Sum=cumsum(value)) %>% 
  ggplot(aes(category, Sum, fill = category)) +
  geom_col(position = 'identity') + 
  ggtitle("{frame_time}") +
  transition_time(date) +
  ease_aes('linear') 
anim_save("GIF.gif")

Если это слишком много данных, я рекомендую увеличить время перехода на месяцы вместо дней.

Источник
Другие вопросы по тегам