首页
学习
活动
专区
圈层
工具
发布
首页
学习
活动
专区
圈层
工具
MCP广场
社区首页 >问答首页 >怎样才能让这个ggplot渲染得更快呢?

怎样才能让这个ggplot渲染得更快呢?
EN

Stack Overflow用户
提问于 2021-04-14 12:02:15
回答 1查看 29关注 0票数 1

下面是我正在使用的数据的reprex。geom_segment调用使得渲染变得非常缓慢。有没有其他方法可以更快地达到同样的效果?

代码语言:javascript
运行
复制
library(ggplot2)
library(ggridges)

n <- 5000; l <- c(2, 5, 7, 9); sd_27 <- c(5.9, 11, 14, 17)
df <- data.frame(name = c(rep("A", n), rep("B", n), 
                          rep("C", n), rep("D", n)),
                 value = c(rpois(n, l[1]), rpois(n, l[2]),
                           rpois(n, l[3]), rpois(n, l[4])))

ggplot(df, aes(x = value, y = name, fill = name)) + geom_density_ridges(alpha = 0.8) +
  geom_segment(aes(x = l[[1]], y = "A", xend = l[[1]], yend = 2, color = "mean")) +
  geom_segment(aes(x = l[[2]], y = "B", xend = l[[2]], yend = 3, color = "mean")) +
  geom_segment(aes(x = l[[3]], y = "C", xend = l[[3]], yend = 4, color = "mean")) +
  geom_segment(aes(x = l[[4]], y = "D", xend = l[[4]], yend = 5, color = "mean")) +
  geom_segment(aes(x = sd_27[[1]], y = "A", xend = sd_27[[1]], yend = 2, color = "sd_27")) +
  geom_segment(aes(x = sd_27[[2]], y = "B", xend = sd_27[[2]], yend = 3, color = "sd_27")) +
  geom_segment(aes(x = sd_27[[3]], y = "C", xend = sd_27[[3]], yend = 4, color = "sd_27")) +
  geom_segment(aes(x = sd_27[[4]], y = "D", xend = sd_27[[4]], yend = 5, color = "sd_27"))

EN

回答 1

Stack Overflow用户

回答已采纳

发布于 2021-04-14 14:04:15

与通过单独的geom_segment层添加每个段不同,您可以将段的所有数据放在一个数据帧中,然后通过一个geom_segment添加段,根据microbenchmark的说法,这将渲染时间减少到大约五分之一:

geom_segment

代码语言:javascript
运行
复制
library(ggplot2)
library(ggridges)

set.seed(42)

n <- 5000; l <- c(2, 5, 7, 9); sd_27 <- c(5.9, 11, 14, 17)
df <- data.frame(name = c(rep("A", n), rep("B", n), 
                          rep("C", n), rep("D", n)),
                 value = c(rpois(n, l[1]), rpois(n, l[2]),
                           rpois(n, l[3]), rpois(n, l[4])))

dl <- data.frame(x = l, y = LETTERS[1:4], yend = 2:5, color = "mean")
dsd <- data.frame(x = sd_27, y = LETTERS[1:4], yend = 2:5, color = "sd_27")

d <- do.call(rbind, list(dl, dsd))

p1 <- function() {
  ggplot(df, aes(x = value, y = name, fill = name)) + 
    geom_density_ridges(alpha = 0.8) +
    geom_segment(data = d, aes(x = x, y = y, xend = x, yend = yend, color = color), inherit.aes = FALSE)
}

p2 <- function() {
  ggplot(df, aes(x = value, y = name, fill = name)) + geom_density_ridges(alpha = 0.8) +
    geom_segment(aes(x = l[[1]], y = "A", xend = l[[1]], yend = 2, color = "mean")) +
    geom_segment(aes(x = l[[2]], y = "B", xend = l[[2]], yend = 3, color = "mean")) +
    geom_segment(aes(x = l[[3]], y = "C", xend = l[[3]], yend = 4, color = "mean")) +
    geom_segment(aes(x = l[[4]], y = "D", xend = l[[4]], yend = 5, color = "mean")) +
    geom_segment(aes(x = sd_27[[1]], y = "A", xend = sd_27[[1]], yend = 2, color = "sd_27")) +
    geom_segment(aes(x = sd_27[[2]], y = "B", xend = sd_27[[2]], yend = 3, color = "sd_27")) +
    geom_segment(aes(x = sd_27[[3]], y = "C", xend = sd_27[[3]], yend = 4, color = "sd_27")) +
    geom_segment(aes(x = sd_27[[4]], y = "D", xend = sd_27[[4]], yend = 5, color = "sd_27"))
}

# Check plot
p1()
#> Picking joint bandwidth of 0.381

代码语言:javascript
运行
复制
# Compare running time
microbenchmark::microbenchmark(p1()) 
#> Unit: milliseconds
#>  expr      min       lq     mean   median      uq      max neval
#>  p1() 1.859514 1.917135 2.162416 1.936781 2.42122 5.056147   100
microbenchmark::microbenchmark(p2())
#> Unit: milliseconds
#>  expr     min       lq     mean   median       uq      max neval
#>  p2() 9.37298 9.669749 10.20821 9.774624 10.17852 22.42459   100
票数 0
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/67085358

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档