Odtnhj

I have a need to place a colorbar to a mesh3d plot that consists of several traces. Each mesh3d trace has a single color, but I need the colorbar to span all the trace-colors.

I am trying to combine a scatter3d with visible="legendonly" with the mesh3d, so achieve this. But when the mesh is plotted, the legend is removed.

Using the helicopter-example:

library(plotly)
library(geomorph)

plyFile <- 'http://people.sc.fsu.edu/~jburkardt/data/ply/chopper.ply'
dest <- basename(plyFile)
if (!file.exists(dest)) 
 download.file(plyFile, dest)


mesh <- read.ply(dest, ShowSpecimen = F)
# 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))


plot_ly() %>%
 # Creates the legend, and also the plotting space
 add_trace(
 x = x, y = y, z = z,
 color = x,
 colors = c("#ffffff", "#000000"),
 # visible="legendonly",
 type = "scatter3d",
 mode="markers"
 ) %>% 

 # Adds the mesh, but removes the legend
 add_trace(
 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"
 )

After a lot of hacking, I finally have a working solution.
In this case, by plotting a mesh3d area, with points that are "inside" the helicopter and will not be visible later, and then plot the actual helicopter later.

It seems that "visible='legendonly'" does not apply to mesh3d, as this option removes both the plot and legend.

library(plotly)
library(geomorph)

plyFile <- 'http://people.sc.fsu.edu/~jburkardt/data/ply/chopper.ply'
dest <- basename(plyFile)
if (!file.exists(dest)) 
 download.file(plyFile, dest)


mesh <- read.ply(dest, ShowSpecimen = F)
# 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]))

# Get colors you want
cols = brewer_pal(palette="RdBu")(9)

# Ramp to add to facecolor
library(scales)
facecolor = colour_ramp(cols)(rescale(x=zmean))

# Create data.frame of colours and breakpoints.
# Must go from 0 to 1, plotly scales it based on values it self.
colz = data.frame(seq(0,1,length.out = length(cols)), 
 cols)

# Make stupid pointcloud to fool the colorbar
xx = c(min(x), max(x))
yy = c(min(y), max(y))
zz = c(min(z), max(z))

plot_ly() %>%

 # Creates the legend, and also the plotting space
 add_trace(
 x = xx, y = yy, z = zz,
 intensity = x,
 colorscale = colz,
 # visible="legendonly",
 type = "mesh3d"
 ) %>% 


 # Adds the mesh
 add_trace(
 x = x, y = y, z = z,
 i = mesh$it[1,]-1, j = mesh$it[2,]-1, k = mesh$it[3,]-1,
 facecolor = facecolor,
 showscale=FALSE,
 type = "mesh3d"
 )