Search code examples
rrgl

Plot 3D group animation in WebGL playwidget in R

I am creating a 3D interactive model using R WebGL to plot groups of data. The script below works for plotting all groups of data, with each group having a separate color. The data contained in input.txt is only a small subset of the overall data. It is important that these be interactive (mouse control to zoom and rotate), hence why plot3D is used versus other tools.

library(rgl)
library(plot3D)

d <- ncol(read.table("./input.txt", header = F))
colClasses <- replace(rep("NULL", d), c(1,2,3,4), NA)
d.data <- lapply("./input.txt", read.table, header = F, colClasses = colClasses)
dval <- do.call("rbind", d.data)

df <- data.frame(dval)
colnames(df) <- c("id", "z", "y", "x")

summary(df)

plot3d(x=df$x, y=df$y, z=df$z, col = df$id, type = 's', radius = 2,
  xlab="X", ylab="Y", zlab="Z")

writeWebGL( filename="input.html" ,  width=600, height=600)

A small example of the input.txt file being read in to replicate this code:

1 0 2 3
1 1 3 3
1 2 4 4
2 5 10 15
2 6 12 16
3 10 9 10
3 11 10 11
3 12 11 12
3 13 12 13
3 14 14 14

I would like to extend this to plot the full data versus only a small subset. This would include having each frame as an interactive 3D plot of each group - like the output from the script above, but rather having an animation showing only 1 group each frame, with a play button to play through all the groups. https://cran.r-project.org/web/packages/rgl/vignettes/WebGL.html shows an example of what I would like to do under Controls > subsetControl. The code showing how they do it:

rglwidget() %>%
playwidget(start = 0, stop = 3, interval = 1,
       subsetControl(1, subsets = list(
                 Setosa = setosa,
                 Versicolor = versicolor,
                 Virginica = virginica,
                 All = c(setosa, versicolor, virginica)
                 )))

I don't want the final image to show all the groups, and I can't use a list similar to their example above as the number of groups will be too many. My attempt at including their example into my script below does not work, rather just shows all the groups in the 3D plot at the same time with no button controls (identical result to the original script).

library(rgl)
library(plot3D)

d <- ncol(read.table("./input.txt", header = F))
colClasses <- replace(rep("NULL", d), c(1,2,3,4), NA)
d.data <- lapply("./input.txt", read.table, header = F, colClasses = colClasses)
dval <- do.call("rbind", d.data)

df <- data.frame(dval)
colnames(df) <- c("id", "z", "y", "x")

summary(df)

plotids <- with(df, plot3d(x=df$x, y=df$y, z=df$z, col = df$id, type = 's', radius = 2,
  xlab="X", ylab="Y", zlab="Z"))

rglwidget(elementId = "plot3drgl")

rglwidget() %>%
playwidget(start = 0, stop = 3, interval = 1,
       subsetControl(1, subsets = df$id
                 ))

writeWebGL( filename="input.html" ,  width=600, height=600)
Solution

  • I think this code does what you want:

    # First, plot everything, and save the ids of the objects in the plot
plotids <- with(df,
   plot3d(x=x, y=y, z=z, col = id, type = 's', radius = 2,
          xlab="X", ylab="Y", zlab="Z"))

# Now plot the different ids one at a time:
ids <- list()
for (i in unique(df$id)) 
  ids <- c(ids, list(with(subset(df, id == i), spheres3d(x,y,z,col=id,radius = 2))))

# Add the full dataset to the list of ids
ids <- c(ids, all = plotids["data"])

# Now plot the scene and add the playwidget.
rglwidget() %>%
  playwidget(start = 0, stop = length(ids) - 1, interval = 1,
             subsetControl(1, subsets = ids,
             ))

    To save this in a file instead of displaying it immediately, wrap it in htmlwidgets::saveWidget, or include it in an R Markdown document. Don't use the deprecated writeWebGL, it knows nothing about the playwidget part.