3D Scatterplots with gg-aframe
shinyaframe provides
a bridge between R and Web-based Virtual Reality (WebVR) experiences
using RStudio
Shiny and Mozilla’s A-Frame WebVR
framework. WebVR is a cross-platform standard that allows the same
content to be delivered to desktop monitors as a 2D projection, to
mobile phones as a 360-degree 3D experience, and to high-end virtual
reality systems as an immersive, hands-on virtual reality
experience.
Building Blocks
The gg-aframe
JavaScript package, also from this package’s author, is included in
shinyaframe and provides a declarative “Grammar of
Graphics” style HTML syntax for constructing 3-Dimensional data
visualizations for WebVR. An example of that syntax for a basic scatter
plot is shown below; refer to the link above for complete
documentation.
<a-scene>
<!-- position and rotation set the plot location in 3D space -->
<a-entity plot scale-shape position="0 1.6 -1.38" rotation="0 35 0">
<a-entity layer-point
data-binding__sepal.length="target: layer-point.x"
data-binding__sepal.width="target: layer-point.y"
data-binding__petal.length="target: layer-point.z"
data-binding__species="target: layer-point.shape"
data-binding__petal.width.size="target: layer-point.size">
</a-entity>
</a-entity>
</a-scene>The data-binding attributes in the
gg-aframe map from a central data repository to the
aesthetic properties of the plot components, and this is where
shinyaframe applies. The aDataScene function
takes as input data from R and adds it to the data-binding
repository using the htmlwidgets R package. Repeat calls
will update the repository and the plot so that interactive
visualizations are simple to implement in a Shiny app.
The example below shows the R code to provide the data for the
gg-aframe plot above. Note that variables mapped to
position and size are scaled in R before sending to
gg-aframe whereas shape is not. In the plot specification,
the scale-shape attribute enables gg-aframe to
take raw input data for shape and map it to a polyhedral scale.
Creating a WebVR Shiny App
Shiny provides the glue to connect the HTML and R in the above
examples. The Shiny app ui will create the HTML
gg-aframe syntax, and the server will
transform and send the data. The Shiny binding functions in
shinyaframe are aDataSceneOuput for the
ui, which will take all additional gg-aframe
syntax as arguments, and renderADataScene for the
server, which will process the data and return a call to
aDataScene. Also included in shinyaframe are
functions to render the custom HTML elements used by A-Frame and
gg-aframe from a ui written in R, and they are exported in
the atags list for convenient access.
The example below creates an iris data 3D scatterplot in a Shiny app. In addition to the code from the examples above, it also includes mapping and output for the axes and legend guides.
library(shiny)
library(dplyr)
library(scales)
library(shinyaframe)
shinyApp(
ui = fluidPage(
aDataSceneOutput(
# attributes and child elements provided as arguments
# server output variable name
outputId = "mydatascene",
# add backdrop
environment = "",
# gg-aframe plot syntax
atags$entity(
# an empty string sets attributes with no additional properties
plot = "",
# sizable scale option uses polyhedra scaled for equivalent volumes
`scale-shape` = "sizable",
position = "0 1.6 -1.38",
atags$entity(
`layer-point` = "",
`data-binding__sepal.length`="target: layer-point.x",
`data-binding__sepal.width`="target: layer-point.y",
`data-binding__petal.length`="target: layer-point.z",
`data-binding__species`="target: layer-point.shape",
`data-binding__petal.width.size`="target: layer-point.size",
`data-binding__species.color`="target: layer-point.color"
),
atags$entity(
`guide-axis` = "axis: x",
`data-binding__xbreaks` = "target: guide-axis.breaks",
`data-binding__xlabels` = "target: guide-axis.labels",
`data-binding__xtitle` = "target: guide-axis.title"
),
atags$entity(
`guide-axis` = "axis: y",
`data-binding__ybreaks` = "target: guide-axis.breaks",
`data-binding__ylabels` = "target: guide-axis.labels",
`data-binding__ytitle` = "target: guide-axis.title"
),
atags$entity(
`guide-axis` = "axis: z",
`data-binding__zbreaks` = "target: guide-axis.breaks",
`data-binding__zlabels` = "target: guide-axis.labels",
`data-binding__ztitle` = "target: guide-axis.title"
),
atags$entity(
`guide-legend` = "aesthetic: shape",
`data-binding__shapetitle` = "target: guide-legend.title"
),
atags$entity(
`guide-legend` = "aesthetic: size",
`data-binding__sizebreaks` = "target: guide-legend.breaks",
`data-binding__sizelabels` = "target: guide-legend.labels",
`data-binding__sizetitle` = "target: guide-legend.title"
),
atags$entity(
`guide-legend` = "aesthetic: color",
`data-binding__colorbreaks` = "target: guide-legend.breaks",
`data-binding__colorlabels` = "target: guide-legend.labels",
`data-binding__colortitle` = "target: guide-legend.title"
),
# animate the plot rotation
atags$other('animation', attribute = "rotation",
from = "0 45 0", to = "0 405 0",
dur = "10000", `repeat` = "indefinite")
)
)
),
server = function(input, output, session) {
output$mydatascene <- renderADataScene({
names(iris) <- tolower(names(iris))
# Margin in (0,1) scale keeps polyhedra from sticking out of plot area
positional_to <- c(0.01, 0.99)
# convert to #RRGGBB color
color_scale = setNames(rainbow(3, 0.75, 0.5, alpha = NULL),
unique(iris$species))
iris %>%
# scale positional data
mutate_if(is.numeric, rescale, to = positional_to) %>%
# scale size data to relative percentage, using cube root to correct
# for radius->volume perception bias
mutate(petal.width.size = rescale(petal.width^(1/3), to = c(0.5, 2)),
species.color = color_scale[species]) ->
iris_scaled
# provide guide info
make_guide <- function (var, aes, breaks = c(0.01, 0.5, 0.99)) {
guide = list()
domain = range(iris[[var]])
guide[[paste0(aes, "breaks")]] <- breaks
guide[[paste0(aes, "labels")]] <- c(domain[1],
round(mean(domain), 2),
domain[2])
guide[[paste0(aes, "title")]] <- var
guide
}
Map(make_guide,
var = c("sepal.length", "sepal.width", "petal.length"),
aes = c("x", "y", "z")) %>%
# repeat radius adjustment in the guide
c(list(make_guide("petal.width", "size", c(0.5, 1.25, 2)^(1/3)))) %>%
Reduce(f = c) ->
guides
guides$shapetitle = "species"
guides$colortitle = "species"
guides$colorbreaks = color_scale
guides$colorlabels = names(color_scale)
# convert data frame to list and combine with guides list
aDataScene(c(iris_scaled, guides))
})
}
)The output of this Shiny app would appear as below:
You can run this example to view the interactive version by calling
example("shinyaframe") (open the app in a Web browser; it
will not function in the RStudio viewer).