Legend3d not rendering

[jamesa8]

I am attempting to add a legend to my WebGL scene in shiny. Although the code works locally with the legend displayed, this does not work when it is ran on shiny. I am just attempting to run some example code at this point.

output$myWebGL <- renderWebGL({
   x <- cumsum(rnorm(100))
   y <- cumsum(rnorm(100))
   z <- cumsum(rnorm(100))
   cuts = cut(x = 1:length(x), breaks = 3)

  plot3d(x, y, z, col=rainbow(3)[cuts],  size = 2, type='s')
  legend3d("topright", legend = paste('Type', c('A', 'B', 'C')), pch = 16, col = rainbow(3), cex=1, inset=c(0.02))
 })

When it is ran as a regular script with
open3d()
par3d(windowRect = c(100, 100, 612, 612))

The window renders properly with the legend. I am not quite sure why this happens and have yet to figure out a workaround for this issue. If you have any ideas for a temporary workaround it would be appreciated.

Thanks.

[chermit]

Here my 2 cents:
#The dataset you provided
data<-data.frame(x=cumsum(rnorm(100)),
y=cumsum(rnorm(100)),
z=cumsum(rnorm(100)))
data$cluster <- cut(x = 1:length(data$x), breaks = 3)

rgl_plot <- function(
data
){
require(rgl) #3d graphic library
require(clusterSim) #function data.Normalization

#data dataframe preparation:
#let's start normalizing data between [0,1]: it' much more easier to deal with!
data <- data.frame(cbind(data.Normalization(data[,1:3],"n4",normalization="column"),cluster=data$cluster))
#add colors to data dataframe depending on clusters
data$colors <-rainbow(length(levels(data$cluster)))[data$cluster]

#legend dataframe preparation:
#a few parameters
distance_x<-1.1 #legend x distance from origin
distance_y<-1.1 #legend y distance from origin
separation_z<-0.1 #vertical separation between legend elements
#the legend dataframe
legend <- data.frame(x=rep(distance_x,length(levels(data$cluster))),
y=rep(distance_y,length(levels(data$cluster))),
z=seq(0.1,
(0.1+separation_z*(length(levels(data$cluster))-1)),
separation_z),
cluster=levels(data$cluster),
colors=rainbow(length(levels(data$cluster))))

#RGL plot preparation:
#a few parameters
size <- ifelse(((100/length(data$x))^(1/3))_0.015>0.01,
((100/length(data$x))^(1/3))_0.015,
0.01) #the size of the spheres depending on the number of your observations
#Here if you have a lot of observation you should consider to plot them as point (rgl.points())

#RGL rendering set-up
rgl.bg(col="white", fogtype="linear")

#RGL plotting:
#data plotting
rgl.spheres(data$x, data$y, data$z,
color=data$colors,
radius=size)
#legend plotting
rgl.spheres(legend$x, legend$y, legend$z,
color=legend$colors,
radius=size)
text3d(legend$x, legend$y, legend$z,
texts=legend$cluster,
adj=1.2,
cex=0.4,
col="black")

#axis,grids and plane plotting
a<-list(c(0.1,0.1),c(0.2,0.2),c(0.3,0.3),c(0.4,0.4),c(0.5,0.5),c(0.6,0.6),c(0.7,0.7),c(0.8,0.8),c(0.9,0.9))
b<-list(c(-0.1,1),c(-0.1,1),c(-0.1,1),c(-0.1,1),c(-0.1,1),c(-0.1,1),c(-0.1,1),c(-0.1,1),c(-0.1,1))
c<-list(c(0,0),c(0,0),c(0,0),c(0,0),c(0,0),c(0,0),c(0,0),c(0,0),c(0,0))
#x axis
rgl.lines(c(-0.2,1.1), c(0,0), c(0,0), color="black")
rgl.triangles(c(1.05,1,1), c(0,0.02,-0.02), c(0,0,0), color="black")
for(i in 1:9){
rgl.lines(a[[i]],b[[i]],c[[i]], color="black", alpha=0.3)#x,y
rgl.lines(a[[i]],c[[i]],b[[i]], color="black", alpha=0.1)#x,z
}
rgl.texts(0.97, 0, 0.01, "X", adj=1, cex=0.5, color="black")
#y axis
rgl.lines(c(0,0), c(-0.2,1.1), c(0,0), color="black")
rgl.triangles(c(0,0.02,-0.02), c(1.05,1,1), c(0,0,0), color="black")
for(i in 1:9){
rgl.lines(b[[i]],a[[i]],c[[i]], color="black", alpha=0.3)#x,y
rgl.lines(b[[i]],c[[i]],a[[i]], color="black", alpha=0.1)#x,z
}
rgl.texts(0, 0.97, 0.01, "Y", adj=1, cex=0.5, color="black")
#z axis
rgl.lines(c(0,0), c(0,0), c(-0.2,1.1), color="black")
rgl.triangles(c(0,0.02,-0.02), c(0,0,0), c(1.05,1,1),color="black")
for(i in 1:9){
rgl.lines(c[[i]],a[[i]],b[[i]], color="black", alpha=0.1)#y,z
rgl.lines(c[[i]],b[[i]],a[[i]], color="black", alpha=0.1)#y,z
}
rgl.texts(0.01, 0.01, 0.97, "Z", adj=1, cex=0.5, color="black")
#x,y plane
rgl.planes(c(0,0,-1), color="black", alpha=0.1)
}

#now you can call the rgl_plot function
output$myWebGL <- renderWebGL({
rgl_plot(data)
})

Saluti,
Marco

[jamesa8]

Thanks Marco. This is very helpful and is a useful workaround. 👍 :)

Best,
Amber