trestletech / shinyRGL

Shiny wrappers for RGL (WebGL)
MIT License
53 stars 22 forks source link

Legend3d not rendering #12

Open jamesa8 opened 9 years ago

jamesa8 commented 9 years ago

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 commented 9 years ago

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 commented 9 years ago

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

Best, Amber