Author: William Murphy, M.S., R.D.N.
Date: 2017-11-24

# 3D Scatterplots with gg-aframe

#### William Murphy, M.S., R.D.N.

#### 2017-11-24

`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.

    library(dplyr)
    library(scales)
    library(shinyaframe)

    names(iris) <- tolower(names(iris))
    iris %>%
      # scale positional data to (0,1)
      mutate_if(is.numeric, rescale) %>%
      # scale size data to relative percentage
      mutate(petal.width.size = rescale(petal.width, to = c(0.5, 2))) %>%
      aDataScene()

## 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:

Screenshot of 3D scatterplot

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).