ggrgl：用ggplot做3D图表
写在前面
rgl包我们知道在R语言里面做3D图表很好，这里是之前r语言中一些3D图表教程，点击。或者转化ggplot为3D图形，点击查看，在今年11月23日，cran跟新的ggrgl包，用于ggplot的3D图形的绘制，使用了图形语法，更加方便的做3D图形。
ggrgl依赖很多R包，这里一次性安装。
新的标度 Z
z标尺和x或者y标尺一样的使用方法，z坐标轴通过设置extrude = TRUE(在支持它的geoms上)，凸起的元素与地面相连，就好像它是从地面上被挤压出来的一样。
有新的z标尺，就有新的设置scale函数：
- extrude_z Lower limit of extrusion 0.05
- extrude_face_fill Extruded face colour grey20
- extrude_face_alpha Extruded face alpha 1
- extrude_edge_colour Edge colour for extrusion NA
- extrude_edge_alpha Edge alpha for extrusion 1
- extrude_edge_size Width of line for extruded edges 1
三维图层两种类型 z和3D
library(ggplot2)
library(ggrgl)
p <- ggplot(mpg) +
geom_bar_z(aes(x=class, fill=class), colour='black', z=200, extrude=TRUE)
devoutrgl::rgldev()
p
invisible(dev.off())
# ?geom_line_3d
p <- ggplot(mpg) +
geom_line_3d(aes(x=displ, y = cty,color=class), colour='black', z=200, extrude=TRUE)
devoutrgl::rgldev()
p
set.seed(1)
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Model Parameters
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
N <- 20
zoffset <- 10
theta_inc <- 10
helix_r <- 1
theta <- seq_len(N) * theta_inc * pi/180
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Create model
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
dna <- data.frame(
x1 = helix_r * cos(theta),
y1 = helix_r * sin(theta),
x2 = helix_r * cos(theta + pi),
y2 = helix_r * sin(theta + pi),
z = seq_len(N) * zoffset,
base = sample(c('A', 'T', 'C', 'G'), size = N, replace = TRUE)
)
dna$cbase <- c(A='T', T='A', C='G', G='C')[dna$base]
p <- ggplot(dna) +
geom_sphere_3d(aes(x1, y1, z = z, colour = base), size = 15) +
geom_sphere_3d(aes(x2, y2, z = z, colour = cbase), size = 15) +
geom_segment_3d(aes(x = x1, y = y1, z = z, xend = x2, yend = y2, zend = z), alpha = 0.25) +
coord_equal() +
theme_ggrgl() +
labs(
title = "Simple DNA Model",
subtitle = "ggrgl::geom_sphere_3d() + geom_segment_3d() with {devoutrgl}"
) +
scale_color_brewer(palette = 'Dark2')
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# plot in 3d with devoutrgl
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
devoutrgl::rgldev(fov = 30, view_angle = -40, zscale = 5)
p
invisible(dev.off())
p <- ggplot(mpg) +
geom_bar_z(
aes(x = class, fill = class, extrude_face_fill = class),
colour = 'black',
z = 50,
extrude = TRUE,
extrude_edge_colour = 'grey10'
) +
labs(
title = "ggrgl::geom_bar_z()",
subtitle = "with {devoutrgl}"
) +
theme_ggrgl()
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Render Plot in 3d with {devoutrgl}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
devoutrgl::rgldev(fov = 30, view_angle = -30)
p
invisible(dev.off())
plot_df <- data.frame(
group = factor(c("Cool", "But", "Use", "Less"),
levels = c("Cool", "But", "Use", "Less")),
value = c(20, 20, 30, 30),
z = c(10, 30, 5, 15)
)
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Use `geom_bar_z()`
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
p <- ggplot(plot_df, aes(x="", y=value, fill=group, z = z)) +
geom_bar_z(width = 1, stat = "identity", extrude = TRUE, extrude_face_fill = 'grey40') +
coord_polar("y", start=0) +
theme_ggrgl() +
labs(
title = "ggrgl::geom_bar_z()",
subtitle = "with {devoutrgl}"
)
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Render Plot in 3d with {devoutrgl}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
devoutrgl::rgldev(fov = 30, view_angle = -30)
p
invisible(dev.off())
library(CP1919) # Pulsar data used for Joy Division album cover
library(ggplot2)
library(dplyr)
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Tweak the pulsar data such that the baseline is always at y = 0
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
pulsar_df <- CP1919 %>%
group_by(line) %>%
mutate(
y = y - min(y)
) %>%
ungroup()
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# ribbon plot
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
p <- ggplot(pulsar_df) +
geom_ribbon_z(aes(x, ymax=y, group=line, z = line), ymin = 0, colour='white') +
theme_void() +
coord_fixed()
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Render Plot in 3d with {devoutrgl}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
devoutrgl::rgldev(fov = 30, view = 'flat', view_flat_angle = 30, zscale = 4)
p
invisible(dev.off())
rgl::rgl.bg(color = 'black')
huron <- data.frame(year = 1875:1972, level = as.vector(LakeHuron))
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Create plot with `geom_ribbon_z()`
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
p <- ggplot(huron, aes(year)) +
geom_ribbon_z(aes(ymin=level-1, ymax=level+1), z = 100, extrude = TRUE,
extrude_face_fill = 'grey50', keep2d = TRUE) +
labs(
title = "ggrgl::geom_ribbon_z()",
subtitle = "with {devoutrgl}"
)
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Render Plot in 3d with {devoutrgl}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
devoutrgl::rgldev(fov = 30, view_angle = -30)
p
invisible(dev.off())
set.seed(1)
N <- 10
x <- LETTERS[1:N]
y <- paste0("var", seq(1,N))
data <- expand.grid(X=x, Y=y)
data$Z <- runif(N*N, 0, 5)
p <- ggplot(data, aes(X, Y, fill= Z, z= Z)) +
geom_tile_z(extrude = TRUE, mapping = aes(extrude_face_fill = Z)) +
coord_equal() +
labs(
title = "ggrgl::geom_tile_z() rendering heights",
subtitle = "with {devoutrgl}"
)
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Render Plot in 3d with {devoutrgl}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
devoutrgl::rgldev(fov = 30, view_angle = -30)
p
invisible(dev.off())
library(dplyr)
library(ggplot2)
library(purrr)
library(tibble)
library(tidyr)
library(rgl)
library(ggrgl)
library(viridis)
p <- volcano %>%
# Data wrangling
as_tibble() %>%
rowid_to_column(var="X") %>%
gather(key="Y", value="Z", -1) %>%
# Change Y to numeric
mutate(Y=as.numeric(gsub("V","",Y))) %>%
# Viz
ggplot(aes(X, Y, fill= Z, colour = Z, z = Z)) +
geom_tile_z(extrude = TRUE) +
theme_ggrgl() +
theme(legend.position="none") +
scale_fill_viridis_c(option = 'A') +
scale_colour_viridis_c(option = 'A') +
coord_equal() +
labs(
title = "ggrgl::geom_tile_z() rendering volcano",
subtitle = "with {devoutrgl}"
)
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Render Plot in 3d with {devoutrgl}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
devoutrgl::rgldev(fov = 30, view_angle = -30)
p
invisible(dev.off())
library(ggplot2)
library(rgl)
library(ggrgl)
library(ambient)
library(dplyr)
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
set.seed(3)
N <- 30
dat <- long_grid(x = seq(0, 10, length.out = N), y = seq(0, 10, length.out = N)) %>%
mutate(
noise =
gen_perlin(x, y, frequency = 0.3) +
gen_perlin(x, y, frequency = 2) / 10
)
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Plot each location as a coloured tile
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ggplot(dat) +
geom_tile(aes(x, y, fill = noise)) +
scale_fill_gradientn(colours = topo.colors(10)) +
theme_bw() +
coord_equal()
p <- ggplot(dat, aes(x, y, z = noise)) +
geom_tile_z(aes(fill = noise), colour = NA) +
labs(
title = "ggrgl::geom_tile_z()",
subtitle = "with {devoutrgl}"
) +
theme_ggrgl() +
scale_fill_gradientn(colours = topo.colors(10)) +
coord_equal() +
theme(legend.position = 'none')
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Render Plot in 3d with {devoutrgl}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
devoutrgl::rgldev(fov = 30, view_angle = -30)
p
invisible(dev.off())