3D Plot Exercises

data(mtcars)
data(iris)
data(VADeaths)

library(ggplot2);library(magrittr); library(dplyr); library(reshape2); library(scatterplot3d); library(graph3d); library(plot3D)

csbaPal = c("#16325B", "#0072B4", "#00B0E0", "#007236", "#00AE62",
            "#8FB063", "#9D0817", "#4A0C61", "#6E60AA", "#AB9F3")

Basic Scatterplot with drop arrows in scatterplot3d

myshapes = c(16,17,18) # pch argumehts
mycols = csbaPal[3:5] #3 CSBA colors
iris %$% scatterplot3d(x = Sepal.Length, y = Sepal.Width,
                       z = Petal.Length,
                       main = "Iris Data Scatterplot",
                       xlab = "Sepal Length",
                       ylab = "Sepal Width",
                       zlab = "Petal Length",
                       pch = myshapes[Species %>% as.numeric()],
                       color = mycols[Species %>% as.numeric()],
                       type = "h"
                       )

Scatterplot with regresion plane

data(trees)
s3d = trees %>% 
  scatterplot3d( type = "h", color = csbaPal[6],
                               angle = 55, pch = 16)

lm(Volume~ Girth + Height, data = trees) %>% s3d$plane()

s3d$points3d(seq(10, 20, 2), seq(85, 60, -5),
             seq(60, 10, -10), col = csbaPal[4], 
             type = "h", pch = 8)

Advanced Scatter Plots

iris  %$% 
  scatter3D(x = Sepal.Length, y = Sepal.Width, 
            z = Petal.Length, col = ramp.col(csbaPal[2:5]))

Alternate

mtcars %>% lm(mpg ~ wt + disp, data = .) -> fit

grid.lines = 26 #vis parameter

x.pred = seq(min(mtcars$wt), 
             max(mtcars$wt), length.out= grid.lines)
y.pred = seq(min(mtcars$disp), 
             max(mtcars$disp), length.out = grid.lines)
xy = expand.grid(wt = x.pred, 
                 disp = y.pred)

z.pred = matrix(predict(fit, newdata = xy), 
                nrow = grid.lines, ncol = grid.lines)

fitpoints = predict(fit)

mtcars %$% scatter3D(wt, disp, mpg, pch = 18, cex = 2,
                     theta = 20, phi = 20, ticktype = "detailed",
                     surf = list(x = x.pred, y = y.pred, z = z.pred,
                                 facets = NA, fit = fitpoints))

Alternately,

mtcars %$% scatter3D(wt, disp, mpg, pch = 19, cex = .5, phi = 0,
                     bty = "g", type = "h", ticktype = "detailed")

3D Histogram

VADeaths %>% hist3D(x = 1:5, y = 1:4, z = .,
                    main = "Virginia Deaths",
                    bty = "g", phi = 20, theta = -60, 
                    border = "black", shade = .2, 
                    ticktype = "detailed",
                    xlab = "", ylab = "", zlab = "", 
                    col = csbaPal[4],
                    space = .15, cex.axis = 1e-9,
                    cex.clab = 1)

text3D(x = 1:5, y = rep(.5, 5), z = rep(3,5),
       labels = rownames(VADeaths), add = TRUE, adj = 1,
       cex.clab = .8)

text3D(x = rep(1,4), y = 1:4, z = rep(0, 4),
       labels = colnames(VADeaths),
       add = TRUE, adj = 1,
       cex.clab = .8)

Interactive 3D Plot

library(car)
library(rgl)
iris %$% scatter3d(x = Sepal.Length,
                   y = Sepal.Width, z = Petal.Length)

rglwidget()

Interactive 3D plot w/ Regresion Plane

attach(iris)
x = Sepal.Length
y = Petal.Length
z = Sepal.Width

rgl.spheres(x, y , z, r = .2, color = csbaPal[3])
rgl_add_axes(x,y,z, show.box = FALSE)

aspect3d(1,1,1)

fit = lm(y~x + z)

grid.lines = 26

x.pred = seq(min(x), max(x), length.out = grid.lines)
z.pred = seq(min(z), max(z), length.out = grid.lines)

xz = expand.grid(x = x.pred, z = z.pred)
y.pred = matrix(predict(fit, newdata = xz),
                nrow = grid.lines, ncol = grid.lines)

rgl.surface(x.pred, z.pred, y.pred, color = csbaPal[1],
            alpha = .5, lit = FALSE, add = TRUE)

rgl.surface(x.pred, z.pred, y.pred, color = "black",
            alpha = .5, lit = FALSE, font = "lines", 
            back = "lines", add = TRUE)

rglwidget()