R可视乎|三维散点图

简介

上期我们说了气泡图。如果我们将气泡图的三维数据绘制到三维坐标系中，通常称其为三维散点图，即用在三维X-Y-Z图上针对一个或多个数据序列绘出三个度量的一种图表。

有关散点图前几部分系列可见（可跳转）：

• 趋势显示的二维散点图

• 分布显示的二维散点图

• 气泡图

R 中scatterplot3d包的scatterplot3d()函数、rgl包的plot3d()函数、plot3D包的scatter3D()函数等都可以绘制三维散点图。

下面将从两个包的两个函数（scatter3D(),plot3d()）入手，一步步带你完成三维散点图的绘制。本文内容丰富，希望大家都能学到自己想要的内容，学习不易，欢迎反馈建议。

本文框架

数据介绍

数据集鸢尾花数据（iris），具体变量的参相信大家再熟悉不过了，我这里就展示前几行数据：

plot3D包scatter3D()

scatter3D (x, y, z, ..., colvar = z, phi = 40, theta = 40,
           col = NULL, breaks = NULL,
           colkey = NULL, panel.first = NULL, 
           clim = NULL, clab = NULL, 
           bty = "b", CI = NULL, surf = NULL, 
           add = FALSE, plot = TRUE)

简单绘制教程

先通过该函数进行一个简单三维散点图的构建：以Sepal.Length为x轴，Sepal.Width为y轴，Petal.Length为z轴。绘制箱子型box = TRUE;旋转角度为theta = 60, phi = 20;透视转换强度的值为3d=3;按照2D图绘制正常刻度ticktype = "detailed";散点图的颜色设置bg="#F57446"

pmar <- par(mar = c(5.1, 4.1, 4.1, 6.1)) #改版画布版式大小
with(iris, scatter3D(x = Sepal.Length, y = Sepal.Width, z = Petal.Length,
  pch = 21, cex = 1.5,col="black",bg="#F57446",
                   xlab = "Sepal.Length",
                   ylab = "Sepal.Width",
                   zlab = "Petal.Length", 
                   ticktype = "detailed",bty = "f",box = TRUE,
                   theta = 60, phi = 20, d=3,
                   colkey = FALSE)
)

加入第四个变量

上图可以看出三者之间的关系，但是如果要加入第四个变量（Petal.Width）该怎么绘制到三维散点图中？

方法一:
可以将变量Petal.Width映射到数据点颜色中。该变量是连续性，如果想将数据按从小到大分成n类，则可以使用dplyr包中的ntile()函数，然后依次设置不同组的颜色bg=colormap[iris$quan]，并根据映射的数值添加图例颜色条（colkey()）。

这里我们将第四个变量划分成6类，使用颜色条图例进行展示。

library(tidyverse)
iris = iris %>% mutate(quan = ntile(Petal.Width,6))
colormap <- colorRampPalette(rev(brewer.pal(11,'RdYlGn')))(6)#legend颜色配置
pmar <- par(mar = c(5.1, 4.1, 4.1, 6.1))
# 绘图
with(iris, scatter3D(x = Sepal.Length, y = Sepal.Width, z = Petal.Length,pch = 21, cex = 1.5,col="black",bg=colormap[iris$quan],
     xlab = "Sepal.Length",
     ylab = "Sepal.Width",
     zlab = "Petal.Length", 
     ticktype = "detailed",bty = "f",box = TRUE,
     theta = 60, phi = 20, d=3,
     colkey = FALSE)
)
colkey (col=colormap,clim=range(iris$quan),clab = "Petal.Width", add=TRUE, length=0.4,side = 4)

方法二:
将第四维数据映射到数据点的大小上(cex = rescale(iris$quan, c(.5, 4)))
这里我还“得寸进尺”的将颜色也来反应第四维变量，当然你也可以用颜色反应第五维变量。

pmar <- par(mar = c(5.1, 4.1, 4.1, 6.1))
with(iris, scatter3D(x = Sepal.Length, y = Sepal.Width, z = Petal.Length,pch = 21, 
                     cex = rescale(iris$quan, c(.5, 4)),col="black",bg=colormap[iris$quan],
                     xlab = "Sepal.Length",
                     ylab = "Sepal.Width",
                     zlab = "Petal.Length", 
                     ticktype = "detailed",bty = "f",box = TRUE,
                     theta = 30, phi = 15, d=2,
                     colkey = FALSE)
)
breaks =1:6
legend("right",title =  "Weight",legend=breaks,pch=21,
       pt.cex=rescale(breaks, c(.5, 4)),y.intersp=1.6,
       pt.bg = colormap[1:6],bg="white",bty="n")

同理，我们绘制出以鸢尾花不同类别作为第四个变量的三维散点图。通过该图可以清晰看到不同类别的鸢尾花特征非常不同。

library(wesanderson)
pmar <- par(mar = c(5.1, 4.1, 4.1, 7.1))
colors0 <-  wes_palette(n=3, name="Darjeeling1")
colors <- colors0[as.numeric(iris$Species)]
with(iris, scatter3D(x = Sepal.Length, y = Sepal.Width, z = Petal.Length, #bgvar = mag,
                   pch = 21, cex = 1.5,col="black",bg=colors,
                   xlab = "longitude", ylab = "latitude",
                   zlab = "depth, km", 
                   ticktype = "detailed",bty = "f",box = TRUE,
                   #panel.first = panelfirst,
                   theta = 140, phi = 20, d=3,
                   colkey = FALSE)#list(length = 0.5, width = 0.5, cex.clab = 0.75))
)

legend("right",title =  "Species",legend=c("setosa", "versicolor", "virginica"),pch=21,
       cex=1,y.intersp=1,pt.bg = colors0,bg="white",bty="n")

rgl包 plot3d()

接下来看看另一个包—rgl包。函数及其参数如下：

plot3d(x, y, z,  
	     xlab, ylab, zlab, type = "p", col,  
	     size, lwd, radius,
	     add = FALSE, aspect = !add, 
	     xlim = NULL, ylim = NULL, zlim = NULL, 
	     forceClipregion = FALSE, ...)

简单绘制

library(rgl)
#数据
mycolors <- c('royalblue1', 'darkcyan', 'oldlace')
iris$color <- mycolors[ as.numeric(iris$Species) ]
#绘制
plot3d( 
  x=iris$`Sepal.Length`, y=iris$`Sepal.Width`, z=iris$`Petal.Length`, 
  col = iris$color, 
  type = 's', 
  radius = .1,
  xlab="Sepal Length", ylab="Sepal Width", zlab="Petal Length")

[外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传(img-kWfJKhdm-1606045060136)(https://imgkr2.cn-bj.ufileos.com/aacbd03f-2d60-4974-8a89-7db088e6e76b.png?UCloudPublicKey=TOKEN_8d8b72be-579a-4e83-bfd0-5f6ce1546f13&Signature=ZGgBMNurCOT2rtgrvhFniEC4vYc%253D&Expires=1606116333)\

可使用：writeWebGL( filename="3dscatter.html" , width=600, height=600)将其进行保存html格式或者其他格式。然后打开这个html，可以进行互动。

动态3D图

rgl包还提供了plot3d()和play3d()函数，允许将3d图表动画化，并最终以.gif格式导出结果，具体可看Animated 3d chart with R.

流程：先构建静态图plot3d()，然后用play3d()进行坐标轴旋转50次duration = 50，最后使用movie3d()进行动图保存。

library(rgl)
library(magick)

colors <- c("royalblue1", "darkcyan", "oldlace")
iris$color <- colors[ as.numeric( as.factor(iris$Species) ) ]
#静态图
plot3d( iris[,1], iris[,2], iris[,3], col = iris$color, type = "s", radius = .2 )
#动态图
play3d( spin3d( axis = c(0, 0, 1), rpm = 20), duration = 50 
#保存动态图
movie3d(
    movie="3dAnimatedScatterplot",
    spin3d( axis = c(0, 0, 1), rpm = 7),
    duration = 10,
    dir = "~/Desktop",
    type = "gif",
    clean = TRUE
)