如何解决我怎样才能让这个 ggplot 渲染得更快?
以下是我正在处理的数据的再现。 geom_segment
调用使渲染非常缓慢。有没有其他方法可以更快地获得相同的结果?
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",rep("C",rep("D",n)),value = c(rpois(n,l[1]),rpois(n,l[2]),l[3]),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]],xend = sd_27[[1]],color = "sd_27")) +
geom_segment(aes(x = sd_27[[2]],xend = sd_27[[2]],color = "sd_27")) +
geom_segment(aes(x = sd_27[[3]],xend = sd_27[[3]],color = "sd_27")) +
geom_segment(aes(x = sd_27[[4]],xend = sd_27[[4]],color = "sd_27"))
解决方法
不是通过单独的 geom_segment
层添加每个段,您可以将段的所有数据放在一个数据框中,并通过一个 geom_segment
添加段,根据 microbenchmark
减少渲染时间约为五分之一:
geom_segment
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",rep("C",rep("D",n)),value = c(rpois(n,l[1]),rpois(n,l[2]),l[3]),l[4])))
dl <- data.frame(x = l,y = LETTERS[1:4],yend = 2:5,color = "mean")
dsd <- data.frame(x = sd_27,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,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]],xend = sd_27[[1]],color = "sd_27")) +
geom_segment(aes(x = sd_27[[2]],xend = sd_27[[2]],color = "sd_27")) +
geom_segment(aes(x = sd_27[[3]],xend = sd_27[[3]],color = "sd_27")) +
geom_segment(aes(x = sd_27[[4]],xend = sd_27[[4]],color = "sd_27"))
}
# Check plot
p1()
#> Picking joint bandwidth of 0.381
# 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
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。