Basic scatter plot

library(plot3D)
data(iris)
head(iris)

##   Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1          5.1         3.5          1.4         0.2  setosa
## 2          4.9         3.0          1.4         0.2  setosa
## 3          4.7         3.2          1.3         0.2  setosa
## 4          4.6         3.1          1.5         0.2  setosa
## 5          5.0         3.6          1.4         0.2  setosa
## 6          5.4         3.9          1.7         0.4  setosa

x <- sep.l <- iris$Sepal.Length
y <- pet.l <- iris$Petal.Length
z <- sep.w <- iris$Sepal.Width

#Bieu do don gian nhat
scatter3D(x, y, z, clab = c("Sepal", "Width (cm)"))

#Thay doi point
scatter3D(x, y, z, colvar = NULL, col = "blue",
          pch = 19, cex = 0.5)

Thay đổi hình dạng hộp bao quanh của plot, sử dụng argument bty:

“f”: full box
“b”: default value. Chỉ nhìn thấy mặt sau hộp.
“b2”: mặt sau kết hợp đường grid line.
“g”: grey background with white grid lines.
“bl”: black background.
“bl2”: black background with grey lines.
“n”: loại bỏ box.
“u”: user sẽ tự xác định các argument thủ công col.axis, col.panel, lwd.panel, col.grid, lwd.grid

# full box
scatter3D(x, y, z, bty = "f", colkey = FALSE, main ="bty= 'f'")

# back panels and grid lines are visible
scatter3D(x, y, z, bty = "b2", colkey = FALSE, main ="bty= 'b2'" )

# grey background with white grid lines
scatter3D(x, y, z, bty = "g", colkey = FALSE, main ="bty= 'g'")

# User defined
scatter3D(x, y, z, pch = 18, bty = "u", colkey = FALSE, 
   main ="bty= 'u'", col.panel ="steelblue", expand =0.4, 
   col.grid = "darkblue")

##Color palettes Color palettes là những màu sắc có sẵn trong R, có tên gọi và không phải sử dụng thông qua mã hex.

jet.col(n, alpha): màu mặc định trong plot3D package. jet2.col(n, alpha): giống như jet.col() nhưng thiếu màu xanh đậm. gg.col(n, alpha) and gg2.col(n, alpha) tạo ra các màu như trong ggplot. ramp.col(col = c(“grey”, “black”), n, alpha): tạo ra các màu dựa vào interpolation cường độ màu sắc. alpha.col(col = “grey”, alpha): tạo ra màu thuần (1 là thuần, <0.1 là có làm mờ).

# gg.col: ggplot2 like color
scatter3D(x, y, z, bty = "g", pch = 18, col = gg.col(100))

# ramp.col: custom palettes
scatter3D(x, y, z, bty = "g", pch = 18,
          col = ramp.col(c("blue", "yellow", "red")) )

Change the color by groups

Sử dụng colkey để điều chỉnh màu theo group

scatter3D(x, y, z, bty = "g", pch = 18, 
          col.var = as.integer(iris$Species), 
          col = c("#1B9E77", "#D95F02", "#7570B3"),
          pch = 18, ticktype = "detailed",
          colkey = list(at = c(2, 3, 4), side = 1, 
          addlines = TRUE, length = 0.5, width = 0.5,
          labels = c("setosa", "versicolor", "virginica")) )

Change the position of the legend

# Bottom colkey
scatter3D(x, y, z, bty = "g",
          colkey = list(side = 1, length = 0.5))

3D viewing direction

các arguments theta và phi có thể sử dụng để điều chỉnh lại góc của biểu đồ 3D. phi điều chỉnh độ xoay theo mặt phẳng (trục x,y). theta điều chỉnh theo phương vị (trục z).

scatter3D(x, y, z, theta = 15, phi = 30, bty="g")

Titles and axis labels

tương tự như ggplot2, sử dụng arguments xlab,ylab,zlab để truyền title

scatter3D(x, y, z, pch = 18,  theta = 20, phi = 20,
          main = "Iris data", xlab = "Sepal.Length",
          ylab ="Petal.Length", zlab = "Sepal.Width")

Tick marks and labels

ticktype: nếu để là simple chỉ vẽ mũi tên. nếu để là detailed sẽ vẽ thêm các tick mark và labels.
nticks: số lượng điểm tick được vẽ trên các trục x,y,z.

 scatter3D(x, y, z, phi = 0, bty = "g",
        pch = 20, cex = 2, ticktype = "detailed", nticks= 3)

Add points and text to an existing plot

Để thêm điểm và tên vào một biểu đồ dùng các phương thức sau sau khi khởi tạo biểu đồ 3D:

scatter3D(x, y, z,…, add = TRUE): Adds points
text3D(x, y, z, labels, …, add = TRUE): Adds texts

Add points to an existing plot:

# Create a scatter plot
 scatter3D(x, y, z, phi = 0, bty = "g",
        pch = 20, cex = 2, ticktype = "detailed")
# Add another point (black color)
scatter3D(x = 7, y = 3, z = 3.5, add = TRUE, colkey = FALSE, 
         pch = 18, cex = 3, col = "black")

2. Add texts to an existing plot:

# Create a scatter plot
 scatter3D(x, y, z, phi = 0, bty = "g", pch = 20, cex = 0.5) 
# Add text
text3D(x, y, z,  labels = rownames(iris),
        add = TRUE, colkey = FALSE, cex = 0.5)

Line plot

Sử dụng arguments type = “l” để vẽ đường, type = “b” để vẽ cả đường và điểm

# type ="l" for lines only
 scatter3D(x, y, z, phi = 0, bty = "g", type = "l", 
           ticktype = "detailed", lwd = 4)

# type ="b" for both points and lines
 scatter3D(x, y, z, phi = 0, bty = "g", type = "b", 
           ticktype = "detailed", pch = 20, 
           cex = c(0.5, 1, 1.5))

Add confidence interval

Sử dụng argument ci (confidence interval) để vẽ biểu đồ dạng interval

# Confidence interval
CI <- list(z = matrix(nrow = length(x),
                    data = rep(0.1, 2*length(x))))
head(CI$z)

##      [,1] [,2]
## [1,]  0.1  0.1
## [2,]  0.1  0.1
## [3,]  0.1  0.1
## [4,]  0.1  0.1
## [5,]  0.1  0.1
## [6,]  0.1  0.1

#hai gia tri tuong trung cho do dai ben trai va ben phai cua interval

# 3D Scatter plot with CI
scatter3D(x, y, z, phi = 0, bty = "g", col = gg.col(100), 
          pch = 18, CI = CI)

3D fancy Scatter plot with small dots on basal plane

Tạo hàm scatter3D_fancy()

# Add small dots on basal plane and on the depth plane
scatter3D_fancy <- function(x, y, z,..., colvar = z){
   panelfirst <- function(pmat) {
      XY <- trans3D(x, y, z = rep(min(z), length(z)), pmat = pmat)
      scatter2D(XY$x, XY$y, colvar = colvar, pch = ".", 
              cex = 2, add = TRUE, colkey = FALSE)
   
      XY <- trans3D(x = rep(min(x), length(x)), y, z, pmat = pmat)
      scatter2D(XY$x, XY$y, colvar = colvar, pch = ".", 
              cex = 2, add = TRUE, colkey = FALSE)
  }
  scatter3D(x, y, z, ..., colvar = colvar, panel.first=panelfirst,
    colkey = list(length = 0.5, width = 0.5, cex.clab = 0.75)) 
}

Hàm scatter3D_fancy sẽ tạo ra panel.first là mặt phẳng 2D và truyền vào các panel để tạo hiệu ứng bóng đổ

Fancy scatter plot:

scatter3D_fancy(x, y, z, pch = 16,
    ticktype = "detailed", theta = 15, d = 2,
    main = "Iris data",  clab = c("Petal", "Width (cm)") )

Regression plane

Để tạo ra mặt phẳng regression trên R chúng ta sử dụng argument surf (viết tắt của surface)

# x, y, z variables
x <- mtcars$wt
y <- mtcars$disp
z <- mtcars$mpg
# Compute the linear regression (z = ax + by + d)
fit <- lm(z ~ x + y)
# predict values on regular xy grid
grid.lines = 26
x.pred <- seq(min(x), max(x), length.out = grid.lines)
y.pred <- seq(min(y), max(y), length.out = grid.lines)
xy <- expand.grid( x = x.pred, y = y.pred)
z.pred <- matrix(predict(fit, newdata = xy), 
                 nrow = grid.lines, ncol = grid.lines)
# fitted points for droplines to surface
fitpoints <- predict(fit)
# scatter plot with regression plane
scatter3D(x, y, z, pch = 18, cex = 2, 
    theta = 20, phi = 20, ticktype = "detailed",
    xlab = "wt", ylab = "disp", zlab = "mpg",  
    surf = list(x = x.pred, y = y.pred, z = z.pred,  
    facets = NA, fit = fitpoints), main = "mtcars")

text3D: plot 3-dimensionnal texts

Sử dụng function text3D() như sau:

text3D(x, y, z, labels, …)

argument cần truyền text là labels:

library(tidyverse)
USArrests %>% with(.,text3D(Murder, Assault, Rape, 
  labels = rownames(USArrests), colvar = UrbanPop, 
  col = gg.col(100), theta = 60, phi = 20,
  xlab = "Murder", ylab = "Assault", zlab = "Rape", 
  main = "USA arrests", cex = 0.6, 
  bty = "g", ticktype = "detailed", d = 2,
  clab = c("Urban","Pop"), adj = 0.5, font = 2))

Add thêm points

# Plot texts
with(USArrests, text3D(Murder, Assault, Rape, 
  labels = rownames(USArrests), colvar = UrbanPop, 
  col = gg.col(100), theta = 60, phi = 20,
  xlab = "Murder", ylab = "Assault", zlab = "Rape", 
  main = "USA arrests", cex = 0.6, 
  bty = "g", ticktype = "detailed", d = 2,
  clab = c("Urban","Pop"), adj = 0.5, font = 2))
# Add points
 with(USArrests, scatter3D(Murder, Assault, Rape, 
    colvar = UrbanPop, col = gg.col(100), 
    type = "h", pch = ".", add = TRUE))

Muốn zoom gần hơn thì giảm các range xuống

# Zoom near origin: choose suitable ranges
 plotdev(xlim = c(0, 8), ylim = c(40, 120), 
         zlim = c(10, 25))

3D Histogram

Cú pháp: hist3D (x, y, z, …, colvar = z, col = NULL, add = FALSE)

x,y,z: các trục tọa độ
colvar: màu sắc phân loại của z
col: màu sử dụng cho colvar
add: nếu TRUE thì mặt phẳng sẽ được thêm vào current plot.

data(VADeaths)
#  hist3D and ribbon3D with greyish background, rotated, rescaled,...
hist3D(z = VADeaths, scale = FALSE, expand = 0.01, bty = "g", phi = 20,
        col = "#0072B2", border = "black", shade = 0.2, ltheta = 90,
        space = 0.3, ticktype = "detailed", d = 2)

hist3D (x = 1:5, y = 1:4, z = VADeaths,
        bty = "g", phi = 20,  theta = -60,
        xlab = "", ylab = "", zlab = "", main = "VADeaths",
        col = "#0072B2", border = "black", shade = 0.8,
        ticktype = "detailed", space = 0.15, d = 2, cex.axis = 1e-9)
# Use text3D to label x axis
 text3D(x = 1:5, y = rep(0.5, 5), z = rep(3, 5),
       labels = rownames(VADeaths),
       add = TRUE, adj = 0)
# Use text3D to label y axis
 text3D(x = rep(1, 4),   y = 1:4, z = rep(0, 4),
       labels  = colnames(VADeaths),
       add = TRUE, adj = 1)

fancy 3D histograms

Hàm này rất kinh điển, cho phép đồ thị của ta xoay đều. Chỉ pro mới nên hiểu.

hist3D_fancy<- function(x, y, break.func = c("Sturges", "scott", "FD"), breaks = NULL,
                        colvar = NULL, col="white", clab=NULL, phi = 5, theta = 25, ...){
  
  # Compute the number of classes for a histogram
  break.func <- break.func [1]
  if(is.null(breaks)){
    x.breaks <- switch(break.func,
                       Sturges = nclass.Sturges(x),
                       scott = nclass.scott(x),
                       FD = nclass.FD(x))
    y.breaks <- switch(break.func,
                       Sturges = nclass.Sturges(y),
                       scott = nclass.scott(y),
                       FD = nclass.FD(y))
  } else x.breaks <- y.breaks <- breaks
  
  # Cut x and y variables in bins for counting
  x.bin <- seq(min(x), max(x), length.out = x.breaks)
  y.bin <- seq(min(y), max(y), length.out = y.breaks)
  xy <- table(cut(x, x.bin), cut(y, y.bin))
  z <- xy
  
  xmid <- 0.5*(x.bin[-1] + x.bin[-length(x.bin)])
  ymid <- 0.5*(y.bin[-1] + y.bin[-length(y.bin)])
  
  oldmar <- par("mar")
  par (mar = par("mar") + c(0, 0, 0, 2))
  hist3D(x = xmid, y = ymid, z = xy, ...,
    zlim = c(-max(z)/2, max(z)), zlab = "counts", bty= "g", 
    phi = phi, theta = theta,
    shade = 0.2, col = col, border = "black",
    d = 1, ticktype = "detailed")
   
  scatter3D(x, y,
    z = rep(-max(z)/2, length.out = length(x)),
    colvar = colvar, col = gg.col(100),
    add = TRUE, pch = 18, clab = clab,
    colkey = list(length = 0.5, width = 0.5,
       dist = 0.05, cex.axis = 0.8, cex.clab = 0.8)
       )
  par(mar = oldmar)
}

hist3D_fancy(quakes$long, quakes$lat, colvar=quakes$depth,
             breaks =30)

hist3D_fancy(iris$Sepal.Length, iris$Petal.Width, 
             colvar=as.numeric(iris$Species))

Other functions

Chúng ta có thể vẽ các mũi tên, segments và hình chữ nhật qua các hàm sau:

arrows3D(x0, y0, z0, x1, y1, z1, …, colvar = NULL, col = NULL, type = “triangle”, add = FALSE)

segments3D(x0, y0, z0, x1, y1, z1, …, colvar = NULL, col = NULL, add = “FALSE”)

rect3D(x0, y0, y0, x1, y1, z1, …, colvar = NULL, col = NULL, add = FALSE)

arrows2D(x0, y0, z0, x1, y1, z1, …, colvar = NULL, col = NULL, type = “triangle”, add = FALSE)

segments2D(x0, y0, z0, x1, y1, z1, …, colvar = NULL, col = NULL, add = “FALSE”)

rect2D(x0, y0, y0, x1, y1, z1, …, colvar = NULL, col = NULL, add = FALSE)

Trong đó:

x0, y0, z0: Điểm xuất phát.
x1, y1, z1: Điểm kết thúc.
colvar: mà sắc
col: mà sắc.
add: có thêm arrow, rectangle hay segment vào hình hay không?

Giả sử chúng ta muốn vẽ 4 mũi tên bắt đầu từ c(x0, ke, z0) kết thúc tại c(x1, y1, z1)

x0 <- c(0, 0, 0, 0)
y0 <- c(0, 0, 0, 0)
z0 <- c(0, 0, 0, 0)
x1 <- c(0.89, -0.46, 0.99, 0.96)
y1 <- c(0.36,  0.88, 0.02, 0.06)
z1 <- c(-0.28, 0.09, 0.05, 0.24)
cols <- c("#1B9E77", "#D95F02", "#7570B3", "#E7298A")

3D Arrows:

arrows3D(x0, y0, z0, x1, y1, z1, colvar = x1^2, col = cols,
         lwd = 2, d = 3, clab = c("Quality", "score"), 
         main = "Arrows 3D", bty ="g", ticktype = "detailed")
# Add starting point of arrow
points3D(x0, y0, z0, add = TRUE, col="darkred", 
          colkey = FALSE, pch = 19, cex = 1)
# Add labels to the arrows
text3D(x1, y1, z1, c("Sepal.L", "Sepal.W", "Petal.L", "Petal.W"),
       colvar = x1^2, col = cols, add=TRUE, colkey = FALSE)

2D arrows:

arrows2D(x0, y0,  x1, y1,  colvar = x1^2, col = cols,
         lwd = 2, clab = c("Quality", "score"), 
          bty ="n", xlim = c(-1, 1), ylim = c(-1, 1))
# Add vertical and horizontal lines at c(0,0)
abline(h =0, v = 0, lty = 2)
# Add starting point of arrow
points2D(x0, y0, add = TRUE, col="darkred", 
          colkey = FALSE, pch = 19, cex = 1)
# Add labels to the arrows
text2D(x1, y1, c("Sepal.L", "Sepal.W", "Petal.L", "Petal.W"),
       colvar = x1^2, col = cols, add=TRUE, colkey = FALSE)

3D rectangle:

Tạo ra mặt phẳng với độ trong suốt bằng 0.5

rect3D(x0 = 0, y0 = 0.5, z0 = 0, x1 = 1, z1 = 5, 
       ylim = c(0, 1), bty = "g", facets = TRUE, 
       border = "red", col ="#7570B3", alpha=0.5,
       lwd = 2, phi = 20)

2D rectangle:

rect2D(x0 = runif(3), y0 = runif(3), 
       x1 = runif(3), y1 = runif(3), colvar = 1:3, 
       alpha = 0.4, lwd = 2, main = "rect2D")

Interactive plot

Sử dụng package plot3Drgl để vẽ biểu đồ tương tác.

plot3Drgl cho phép biểu đồ 3D được tạo thành từ plot3D có thể mở trên openGL. Các bước đơn giản như sau:

Tạo R-graphic từ plot3D.
Sau đó sử dụng plotrgl() để vẽ hình tương tự trên rgl.

rgl cho phép xoay, zoom các khía cạnh của biểu đồ.

# Create his3D using plot3D
hist3D_fancy(iris$Sepal.Length, iris$Petal.Width, colvar=as.numeric(iris$Species))

# Make the rgl version
library("plot3Drgl")
plotrgl()

Link tham khảo:

[http://www.sthda.com/english/wiki/impressive-package-for-3d-and-4d-graph-r-software-and-data-visualization]

Plot3D

Pham Dinh Khanh

April 13, 2018