Nrthugu

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"

  )