Tooltips for ggalluvial plots in Shiny apps

Hovering over and clicking on strata

Enabling hovering over and clicking on strata is straightforward because of their rectangular shape. We only need the minimum and maximum x and y coordinates for each of the rectangles. The rectangles are evenly spaced along the x-axis, centered on positive integers beginning with 1. The width is set in geom_stratum() so, for example, we know that the x-coordinates of the first stratum are c(1 - width/2, 1 + width/2). The y-coordinates can be determined from the number of rows in the input data multiplied by their weights.

Hovering over and clicking on alluvia

Hovering over and clicking on alluvia are more difficult because the shapes of the alluvia are more complex. The default shape of the polygons includes an xspline curve drawn using the {grid} package. We need to manually reconstruct the coordinates of the polygons, then use sp::pointInPolygon() to detect which, if any, polygons the cursor is over.

Loading data

The UC-Berkeley admissions dataset, UCBAdmissions, is used in this example. After loading the necessary packages, the first thing we do in the app is load the data and coerce from array to data frame.

data(UCBAdmissions)
ucb_admissions <- as.data.frame(UCBAdmissions)

Next we set offset, the distance from cursor to tooltip, in pixels, in both x and y directions. We also set node_width and alluvium_width here, which are used as arguments to geom_stratum() and geom_alluvium() below, and again later to determine whether the mouse cursor is hovering over a stratum/alluvium.

# Offset, in pixels, for location of tooltip relative to mouse cursor,
# in both x and y direction.
offset <- 5
# Width of node boxes
node_width <- 1/4
# Width of alluvia
alluvium_width <- 1/3

Drawing the plot and extracting coordinates

Next, we create the ggplot object for the alluvial plot, then we call the ggplot_build() function to build the plot without displaying it.

# Draw plot.
p <- ggplot(ucb_admissions,
            aes(y = Freq, axis1 = Gender, axis2 = Dept)) + 
  geom_alluvium(aes(fill = Admit), knot.pos = 1/4, width = alluvium_width) + 
  geom_stratum(width = node_width, reverse = TRUE, fill = 'black', color = 'grey') + 
  geom_label(aes(label = after_stat(stratum)), 
             stat = "stratum", 
             reverse = TRUE, 
             size = rel(2)) + 
  theme_bw() +
  scale_fill_brewer(type = "qual", palette = "Set1") +
  scale_x_discrete(limits = c("Gender", "Dept"), expand = c(.05, .05)) +
  scale_y_continuous(expand = c(0, 0)) +
  ggtitle("UC Berkeley admissions and rejections", "by sex and department") +
  theme(plot.title = element_text(size = rel(1)),
        plot.subtitle = element_text(size = rel(1)),
        legend.position = 'bottom')

# Build the plot. 
pbuilt <- ggplot_build(p)

Now for the hard part: reverse-engineering the coordinates of the alluvia polygons. This makes use of pbuilt$data[[1]], a data frame with the individual elements of the alluvial plot. We add an additional column for width using the value we set above, then split the data frame by group (groups correspond to the individual alluvium polygons). We apply the function data_to_alluvium() to each element of the list to get the coordinates of the “skeleton” of the x-spline curve. Then, we pass these coordinates to the function grid::xsplineGrob() to fill in the smooth spline curves and convert them into a {grid} object. We pass the resulting object to grid::xsplinePoints(), which converts back into numeric vectors. At this point we now have the coordinates of the alluvium polygons. The object xspline_points is a list with length equal to the number of alluvium polygons in the plot. Each element of the list is a list with elements x and y, which are numeric vectors.

# Add width parameter, and then convert built plot data to xsplines
data_draw <- transform(pbuilt$data[[1]], width = alluvium_width)
groups_to_draw <- split(data_draw, data_draw$group)
group_xsplines <- lapply(groups_to_draw,
                         data_to_alluvium) 

# Convert xspline coordinates to grid object.
xspline_coords <- lapply(
  group_xsplines,
  function(coords) grid::xsplineGrob(x = coords$x, 
                                     y = coords$y, 
                                     shape = coords$shape, 
                                     open = FALSE)
)

# Use grid::xsplinePoints to draw the curve for each polygon
xspline_points <- lapply(xspline_coords, grid::xsplinePoints)

The coordinates we have are in {grid} plotting units but we need to convert them into the same units as the axes on the plot. We do this by determining the range of the x and y-axes in {grid} units (xrange_old and yrange_old). Then we fix the range of the x axis as 1 to the number of strata, adjusted by half the alluvium width on each side. Next we fix the range of the y-axis to the sum of the counts across all alluvia at one node.

# Define the x and y axis limits in grid coordinates (old) and plot
# coordinates (new)
xrange_old <- range(unlist(lapply(
  xspline_points,
  function(pts) as.numeric(pts$x)
)))
yrange_old <- range(unlist(lapply(
  xspline_points,
  function(pts) as.numeric(pts$y)
)))
xrange_new <- c(1 - alluvium_width/2, max(pbuilt$data[[1]]$x) + alluvium_width/2) 
yrange_new <- c(0, sum(pbuilt$data[[2]]$count[pbuilt$data[[2]]$x == 1])) 

We define a function new_range_transform() inline and apply it to each set of coordinates. This returns another list, polygon_coords, with the same structure as xspline_points. Now we have the coordinates of the polygons in plot units!

# Define function to convert grid graphics coordinates to data coordinates
new_range_transform <- function(x_old, range_old, range_new) {
  (x_old - range_old[1])/(range_old[2] - range_old[1]) *
    (range_new[2] - range_new[1]) + range_new[1]
}

# Using the x and y limits, convert the grid coordinates into plot coordinates.
polygon_coords <- lapply(xspline_points, function(pts) {
  x_trans <- new_range_transform(x_old = as.numeric(pts$x), 
                                 range_old = xrange_old, 
                                 range_new = xrange_new)
  y_trans <- new_range_transform(x_old = as.numeric(pts$y), 
                                 range_old = yrange_old, 
                                 range_new = yrange_new)
  list(x = x_trans, y = y_trans)
})

User interface

The app includes a minimal user interface with two output elements.

ui <- fluidPage(
  fluidRow(tags$div(
    style = "position: relative;",
    plotOutput("alluvial_plot", height = "650px", 
               hover = hoverOpts(id = "plot_hover")
               ),
    htmlOutput("tooltip")))
)

The elements are:

• a plotOutput with the argument hover defined, to enable behavior determined by the cursor’s plot coordinates whenever the user hovers over the plot.
• an htmlOutput for the tooltip that appears next to the cursor on hover.

The elements are wrapped in a fluidRow() and a div() tag.

Note: This vignette only illustrates how to display output when the user hovers over an element. If you want to display output when the user clicks on an element, the corresponding argument to plotOutput() is click = clickOpts(id = "plot_click"). This will return the location of the mouse cursor in plot coordinates when the user clicks somewhere within the plot panel.

Also Note: In the example presented here, all of the plot drawing and coordinate extracting code is outside the server() function, because the plot itself does not change with user input. However if you are building an app where the plot changes in response to user input, for example a menu of options of which variables to display, the plot drawing code has to be inside the renderPlot() expression. This means that the coordinates may need to be recalculated each time the user input changes as well. In that case, you may need to use the global assignment operator <<- so that the coordinates are accessible outside the renderPlot() expression.

Server function

In the server function, we first call renderPlot() to draw the plot in the app window.

output$alluvial_plot <- renderPlot(p, res = 200)

Next, we define the tooltip with a renderText() expression. Within that expression, we first extract the cursor’s plot coordinates from the user input. We determine whether the cursor is hovering over a stratum and if so, display the appropriate tooltip.

screenshot of tooltip on stratum

If the mouse cursor is not hovering over a stratum, we determine whether it is hovering over an alluvium polygon and if so, display different information in the tooltip.

screenshot of tooltip on alluvium

If the mouse cursor is hovering over an empty region of the plot, renderText() returns nothing and no tooltip appears.

screenshot of cursor over empty region

Let’s take a deeper dive into the logic used to determine the text that appears in the tooltip.

First, we check whether the cursor is inside the plot panel. If it is not, the element plot_hover of the input will be NULL. In that case renderText() will return nothing and no tooltip will appear.

output$tooltip <- renderText(
  if(!is.null(input$plot_hover)) { ... }
  ...
)

hover <- input$plot_hover
x_coord <- round(hover$x)
    
if(abs(hover$x - x_coord) < (node_width / 2)) { ... } else { ... }

node_row <- 
  pbuilt$data[[2]]$x == x_coord & hover$y > pbuilt$data[[2]]$ymin & hover$y < pbuilt$data[[2]]$ymax

node_label <- pbuilt$data[[2]]$stratum[node_row]
node_n <- pbuilt$data[[2]]$count[node_row]

renderTags(
  tags$div(
    node_label, tags$br(),
    "n =", node_n,
    style = paste0(
      "position: absolute; ",
      "top: ", hover$coords_css$y + offset, "px; ",
      "left: ", hover$coords_css$x + offset, "px; ",
      "background: gray; ",
      "padding: 3px; ",
      "color: white; "
    )
  )
)$html

hover_within_flow <- sapply(
  polygon_coords,
  function(pol) point.in.polygon(point.x = hover$x, 
                                 point.y = hover$y, 
                                 pol.x = pol$x, 
                                 pol.y = pol$y)
)

if (any(hover_within_flow)) { ... }

coord_id <- rev(which(hover_within_flow == 1))[1]
flow_label <- paste(groups_to_draw[[coord_id]]$stratum, collapse = ' -> ')
flow_n <- groups_to_draw[[coord_id]]$count[1]

renderTags(
  tags$div(
    flow_label, tags$br(),
    "n =", flow_n,
    style = paste0(
      "position: absolute; ",
      "top: ", hover$coords_css$y + offset, "px; ",
      "left: ", hover$coords_css$x + offset, "px; ",
      "background: gray; ",
      "padding: 3px; ",
      "color: white; "
    )
  )
)$html