Show Sidebar Hide Sidebar

3D Tri-Surf Plots in R

How to make interactive 3D mesh plots in R.

New to Plotly?

Plotly's R library is free and open source!
Get started by downloading the client and reading the primer.
You can set up Plotly to work in online or offline mode.
We also have a quick-reference cheatsheet (new!) to help you get started!

Version Check

Version 4 of Plotly's R package is now available!
Check out this post for more information on breaking changes and new features available in this version.

library(plotly)
packageVersion('plotly')
## [1] '4.9.1'

Basic Tri-Surf Plot

library(plotly)

p <- plot_ly(
  x = c(0, 1, 2, 0),
  y = c(0, 0, 1, 2),
  z = c(0, 2, 0, 1),
  i = c(0, 0, 0, 1),
  j = c(1, 2, 3, 2),
  k = c(2, 3, 1, 3),
  facecolor = toRGB(viridisLite::viridis(4))
)

p

Cube with Different Face Colors

library(plotly)

p <- plot_ly(
  x = c(0, 0, 1, 1, 0, 0, 1, 1),
  y = c(0, 1, 1, 0, 0, 1, 1, 0),
  z = c(0, 0, 0, 0, 1, 1, 1, 1),
  i = c(7, 0, 0, 0, 4, 4, 2, 6, 4, 0, 3, 7),
  j = c(3, 4, 1, 2, 5, 6, 5, 5, 0, 1, 2, 2),
  k = c(0, 7, 2, 3, 6, 7, 1, 2, 5, 5, 7, 6),
  facecolor = rep(toRGB(viridisLite::inferno(6)), each = 2)
)

p

Helicopter

library(plotly)
library(geomorph)

dest <- "data/chopper.ply"
mesh <- read.ply(dest)
# see getS3method("shade3d", "mesh3d") for details on how to plot

# plot point cloud
x <- mesh$vb["xpts",]
y <- mesh$vb["ypts",]
z <- mesh$vb["zpts",]
m <- matrix(c(x,y,z), ncol=3, dimnames=list(NULL,c("x","y","z")))

# now figure out the colormap
zmean <- apply(t(mesh$it),MARGIN=1,function(row){mean(m[row,3])})

library(scales)
facecolor = colour_ramp(
  brewer_pal(palette="RdBu")(9)
)(rescale(x=zmean))

p <- plot_ly(
  x = x, y = y, z = z,
  i = mesh$it[1,]-1, j = mesh$it[2,]-1, k = mesh$it[3,]-1,
  facecolor = facecolor,
  type = "mesh3d"
)

p

Maps

#devtools::install_github("hypertidy/anglr")
library(anglr)
library(maptools)
library(plotly)
data(wrld_simpl)

map1 <- subset(wrld_simpl,
               NAME %in% c("Indonesia", "Papua New Guinea", "New Zealand", "Australia"))
## DEL model (like TRI in silicate)
delmesh <-  anglr::globe(anglr::DEL(map1, max_area = 0.5))
mesh <- as.mesh3d(delmesh)


# plot point cloud
x <- mesh$vb[1,]
y <- mesh$vb[2, ]
z <- mesh$vb[3,]
m <- matrix(c(x,y,z), ncol=3, dimnames=list(NULL,c("x","y","z")))

# colours in z don't make sense here, need to map object aesthetics above
zmean <- apply(t(mesh$it),MARGIN=1,function(row){mean(m[row,3])})

library(scales)
facecolor = colour_ramp(
  brewer_pal(palette="RdBu")(9)
)(rescale(x=zmean))

p <- plot_ly(
  x = x, y = y, z = z,
  i = mesh$it[1,]-1, j = mesh$it[2,]-1, k = mesh$it[3,]-1,
  facecolor = facecolor,
  type = "mesh3d"
)

p

Inspired by Michael Sumner