linked-views-shiny.Rmd

# Server-side linking with shiny {#linking-views-with-shiny}

Section \@ref(graphical-queries) covers an approach to linking views client-side with graphical database queries, but not every linked data view can be reasonably framed as a database query. If you need more control, you have at least two more options: add custom JavaScript (covered in Chapter \@ref(javascript)) and/or link views server-side via a web application. Some concepts useful for the former approach are covered in Chapter \@ref(javascript), but this chapter is all about the latter approach.

There are several different frameworks for creating web applications via R, but we'll focus our attention on linking **plotly** graphs with **shiny**, an R package for creating reactive web applications entirely in R. **Shiny**'s reactive programming model allows R programmers to build upon their existing R knowledge and create data-driven web applications without any prior web programming experience. **Shiny** itself is largely agnostic to the engine used to render data views (that is, you can incorporate any sort of R output), but **shiny** itself also adds some special support for interacting with static R graphics and images [@shiny-plot-interaction].

When linking graphics in a web application, there are tradeoffs to consider when using static R plots over web-based graphics. As it turns out, those tradeoffs complement nicely with the relative strengths and weaknesses of linking views with **plotly**, making their combination a powerful toolkit for linking views on the web from R. **Shiny** itself provides a way to access events with static graphics made with any of the following R packages: **graphics**, **ggplot2**, and **lattice**. These packages are very mature, fully featured, well-tested, and support an incredibly wide range of graphics, but since they must be regenerated on the server, they are fundamentally limited from an interactive graphics perspective. Comparatively speaking, **plotly** does not have the same range and history, but it does provide more options and control over interactivity. More specifically, because **plotly** is inherently web-based, it allows for more control over how the graphics update in response to user input (e.g., change the color of a few points instead of redrawing the entire image). This idea is explored in more depth in Section \@ref(proxies).

This chapter teaches you how to use **plotly** graphs inside **shiny**, how to get those graphics communicating with other types of data views, and how to do it all efficiently. Section \@ref(hello-shiny) provides an introduction to **shiny** its reactive programming model, Section \@ref(shiny-plotly-inputs) shows how to leverage **plotly** inputs in **shiny** to coordinate multiple views, Section \@ref(proxies) shows how to respond to input changes efficiently, and Section \@ref(advanced-applications) demonstrates some advanced applications.

## Embedding plotly in shiny {#hello-shiny}

Before linking views with **plotly** inside **shiny**, let's first talk about how to embed **plotly** inside a basic **shiny** app! Through a couple of basic examples, you'll learn the basic components of a **shiny** and get a feel for **shiny**'s reactive programming model, as well as pointers to more learning materials.

### Your first shiny app

\index{plotlyOutput()@\texttt{plotlyOutput()}|seealso {renderPlotly()}}
\indexc{renderPlotly()}

The most common **plotly**+**shiny** pattern uses a **shiny** input to control a **plotly** output. Figure \@ref(fig:shiny-intro) gives a simple example of using **shiny**'s `selectizeInput()` function to create a dropdown that controls a **plotly** graph. This example, as well as every other **shiny** app, has two main parts:

1. The *user interface*, `ui`, defines how inputs and output widgets are displayed on the page. The `fluidPage()` function offers a nice and quick way to get a grid-based responsive layout^[Read more about **shiny**'s responsive layout here https://shiny.rstudio.com/articles/layout-guide.html], but it's also worth noting the UI is completely customizable^[Read more about using custom HTML templates here https://shiny.rstudio.com/articles/html-ui.html], and packages such as **shinydashboard** make it easy to leverage more sophisticated layout frameworks [@shinydashboard]. 
2. The *server* function, `server`, defines a mapping from input values to output widgets. More specifically, the **shiny** `server` is an R `function()` between `input` values on the client and `output`s generated on the web server.

Every input widget, including the `selectizeInput()` in Figure \@ref(fig:shiny-intro), is tied to an input value that can be accessed on the server inside a reactive expression. **Shiny**'s reactive expressions build a dependency graph between outputs (aka, reactive endpoints) and inputs (aka, reactive sources). The true power of reactive expressions lies in their ability to chain together and cache computations, but let's first focus on generating outputs. In order to generate an output, you have to choose a suitable function for rendering the result of a reactive expression.

Figure \@ref(fig:shiny-intro) uses the `renderPlotly()` function to render a reactive expression that generates a **plotly** graph. This expression depends on the input value `input$cities` (i.e., the input value tied to the input widget with an `inputId` of `"cities"`) and stores the output as `output$p`. This instructs **shiny** to insert the reactive graph into the `plotlyOutput(outputId = "p")` container defined in the user interface.

```{r eval = FALSE, summary = "Click to show/hide the code"}
library(shiny)
library(plotly)

ui <- fluidPage(
  selectizeInput(
    inputId = "cities", 
    label = "Select a city", 
    choices = unique(txhousing$city), 
    selected = "Abilene",
    multiple = TRUE
  ),
  plotlyOutput(outputId = "p")
)

server <- function(input, output, ...) {
  output$p <- renderPlotly({
    plot_ly(txhousing, x = ~date, y = ~median) %>%
      filter(city %in% input$cities) %>%
      group_by(city) %>%
      add_lines()
  })
}

shinyApp(ui, server)
```

```{r shiny-intro, echo=FALSE, fig.cap="(ref:shiny-intro)"}
include_vimeo("307597444")
```

If, instead of a **plotly** graph, a reactive expression generates a static R graphic, simply use `renderPlot()` (instead of `renderPlotly()`) to render it and `plotOutput()` (instead of `plotlyOutput()`) to position it. Other **shiny** output widgets also use this naming convention: `renderDataTable()`/`datatableOutput()`, `renderPrint()`/`verbatimTextOutput()`, `renderText()`/`textOutput()`, `renderImage()`/`imageOutput()`, etc. Packages that are built on the **htmlwidgets** standard (e.g., **plotly** and **leaflet**) are, in some sense, also **shiny** output widgets that are encouraged to follow this same naming convention (e.g., `renderPlotly()`/`plotlyOutput()` and `renderLeaflet()`/`leafletOutput()`).

**Shiny** also comes pre-packaged with a handful of other useful input widgets. Although many **shiny** apps use them straight "out-of-the-box", input widgets can easily be stylized with CSS and/or SASS, and even custom input widgets can be integrated [@sass; @shiny-custom-inputs].

* `selectInput()`/`selectizeInput()` for dropdown menus.
* `numericInput()` for a single number.
* `sliderInput()` for a numeric range.
* `textInput()` for a character string.
* `dateInput()` for a single date.
* `dateRangeInput()` for a range of dates.
* `fileInput()` for uploading files.
* `checkboxInput()`/`checkboxGroupInput()`/`radioButtons()` for choosing a list of options.

Going forward, our focus is to link multiple graphs in **shiny** through direct manipulation, so we focus less on using these input widgets, and more on using **plotly** and static R graphics as inputs to other output widgets. Section \@ref(shiny-plotly-inputs) provides an introduction to this idea, but before we learn how to access these input events, you may want to know a bit more about rendering **plotly** inside **shiny**.

### Hiding and redrawing on resize

\index{ggplotly()@\texttt{ggplotly()}!Shiny resize@Redraw on resize with \texttt{renderPlotly()}}

The `renderPlotly()` function renders anything that the `plotly_build()` function understands, including `plot_ly()`, `ggplotly()`, and **ggplot2** objects.^[The `plotly_build()` function is an S3 generic, so you can list all relevant methods with `methods(plotly_build)`, and write your own method to translate a custom object to **plotly**.] It also renders `NULL` as an empty HTML div, which is handy for certain cases where it doesn't make sense to render a graph. Figure \@ref(fig:shiny-ggplotly) leverages these features to render an empty div while `selectizeInput()`'s placeholder is shown, but then render a **plotly** graph via `ggplotly()` once cities have been selected. Figure \@ref(fig:shiny-ggplotly) also shows how to make the **plotly** output depend on the size of the container that holds the **plotly** graph. By default, when a browser is resized, the graph size is changed purely client-side, but this reactive expression will re-execute when the browser window is resized. Due to technical reasons, this can improve `ggplotly()` resizing behavior^[In order to convert **grid** grobs that are relatively sized, the `ggplotly()` function uses the size of the current graphics device at print-time, meaning that resizing the browser window without a hook back to R can create wonky sizes.], but should be used with caution when handling large data and long render times.

```{r eval = FALSE, summary = "Click to show/hide the code"}
library(shiny)

cities <- unique(txhousing$city)

ui <- fluidPage(
  selectizeInput(
    inputId = "cities", 
    label = NULL,
    # placeholder is enabled when 1st choice is an empty string
    choices = c("Please choose a city" = "", cities), 
    multiple = TRUE
  ),
  plotlyOutput(outputId = "p")
)

server <- function(input, output, session, ...) {
  output$p <- renderPlotly({
    req(input$cities)
    if (identical(input$cities, "")) return(NULL)
    p <- ggplot(data = filter(txhousing, city %in% input$cities)) + 
      geom_line(aes(date, median, group = city))
    height <- session$clientData$output_p_height
    width <- session$clientData$output_p_width
    ggplotly(p, height = height, width = width)
  })
}

shinyApp(ui, server)
```

```{r shiny-ggplotly, echo=FALSE, fig.cap="(ref:shiny-ggplotly)"}
include_vimeo("307598318")
```

When a reactive expression inside `renderPlotly()` re-executes, it triggers a full redraw of the **plotly** graph on the client. Generally speaking, this makes your **shiny** app logic easy to reason about, but it's not always performant enough. For example, say you have a scatterplot with tens of thousands of points, and you just want to add a fitted line to those points (in response to input event)? Instead of redrawing the whole plot from scratch, it can be way more performant to partially update specific components of the visual. Section \@ref(proxies) covers this idea through a handful of examples.

<!--
The `renderPlotly()` function anticipates a reactive expression that generates a **plotly** object. **Shiny** itself provides a handful of similar functions that anticipate more "standard" R outputs, like data frames (`renderTable()` or `renderDataTable()`), output from the R graphics device (`renderPlot()`), and things printed to the R console (`renderPrint()` or `renderText()`). Other R packages sometimes provide a custom reactive for a custom R object, and in fact, the **htmlwidgets** package provides a standard way to scaffold this reactive glue which **plotly** implements with `renderPlotly()` and **leaflet** implements with `renderLeaflet()`.

Once a reactive expression generates a value, it needs to know where on the user interface to place the output result. That is why the result of `renderPlotly()` in Figure \@ref(fig:shiny-intro) is assigned to `output$p`. This information lets **shiny** know to insert the code result into `plotlyOutput("p")`, the UI output with an id of "p". At face value, it may seem like **shiny**'s reactive expressions can only produce output widgets, but `renderUI()` allows one to dynamically render input widgets on the server as well.
-->

## Leveraging plotly input events {#shiny-plotly-inputs}

Section \@ref(fig:shiny-intro) covered how to render **shiny** output widgets (e.g., `plotlyOutput()`) that depend on an input widget, but what about having an output act like an input to another output? For example, say we'd like to dynamically generate a bar chart (i.e., an output) based on a point clicked on a scatterplot (i.e., an input event tied to an output widget). In addition to **shiny**'s static graph and image rendering functions (e.g., `plotOutput()`/`imageOutput()`), there are a handful of other R packages that expose user interaction with "output" widget(s) as input value(s). @leaflet-shiny and @DT-shiny describe the interface for the **leaflet** and **DT** packages. This section outlines the interface for `plotlyOutput()`. This sort of functionality plays a vital role in linking of views through direct manipulation, similar to what we've already seen in Section \@ref(graphical-queries), but having access to **plotly** events on a **shiny** server allows for much more flexibility than linking views purely client-side.

\index{event\_data()@\texttt{event\_data()}}
\index{event\_data()@\texttt{event\_data()}!customdata@\texttt{customdata}}

The `event_data()` function is the most straightforward way to access **plotly** input events in **shiny**. Although `event_data()` is function, it references and returns a **shiny** input value, so `event_data()` needs to be used inside a reactive context. Most of these available events are data-specific traces (e.g., `"plotly_hover"`, `"plotly_click"`, `"plotly_selected"`, etc.), but there are also some that are layout-specific (e.g., `"plotly_relayout"`). Most plotly.js events^[These events are documented at https://plot.ly/javascript/plotlyjs-events/] are accessible through this interface; for a complete list, see the `help(event_data)` documentation page.

Numerous figures in the following sections show how to access common **plotly** events in **shiny** and do something with the result. When using these events to inform another view of the data, it's often necessary to know what portion of data was queried in the event (i.e., the `x`/`y` positions alone may not be enough to uniquely identify the information of interest). For this reason, it's often a good idea to supply a `key` (and/or `customdata`) attribute, so that you can map the event data back to the original data. The `key` attribute is only supported in **shiny**, but `customdata` is officially supported by plotly.js, and thus can also be used to attach meta-information to event; see Chapter \@ref(javascript) for more details.

### Dragging events

\index{event\_data()@\texttt{event\_data()}!plotly\_click}
\index{event\_data()@\texttt{event\_data()}!plotly\_hover}
\index{event\_data()@\texttt{event\_data()}!plotly\_selecting}
\index{event\_data()@\texttt{event\_data()}!plotly\_selected}
\index{event\_data()@\texttt{event\_data()}!plotly\_brushing}
\index{event\_data()@\texttt{event\_data()}!plotly\_brushed}

There are currently four different modes for mouse click+drag behavior (i.e., `dragmode`) in plotly.js: zoom, pan, rectangular selection, and lasso selection. This mode may be changed interactively via the modebar that appears above a **plotly** graph, but the default mode can also be set from the command-line. The default `dragmode` in Figure \@ref(fig:plotlyEvents) is set to `'select'`, so that dragging draws a rectangular box which highlights markers. When in this mode, or in the lasso selection mode, information about the drag event can be accessed in four different ways: `"plotly_selecting"`, `"plotly_selected"`, `"plotly_brushing"`, and `"plotly_brushed"`. Both the `"plotly_selecting"` and `"plotly_selected"` events emit information about trace(s) appearing within the interior of the brush; the only difference is that `"plotly_selecting"` fires repeatedly *during* drag events, whereas `"plotly_selected"` fires *after* drag events (i.e., after the mouse has been released). The semantics behind `"plotly_brushing"` and `"plotly_brushed"` are similar, but these emit the x/y limits of the selection brush. As for the other two dragging modes (zoom and pan), since they modify the range of the x/y axes, information about these events can be accessed through `"plotly_relayout"`. Sections \@ref(proxies) and \@ref(advanced-applications) both have advanced applications of these dragging events.

```r
plotly_example("shiny", "event_data")
```

```{r plotlyEvents, echo=FALSE, fig.cap = "(ref:plotlyEvents)"}
include_vimeo("327625843", height = 500)
```

### 3D events

\index{event\_data()@\texttt{event\_data()}!plotly\_relayout}
\index{event\_data()@\texttt{event\_data()}!plotly\_legendclick}
\index{event\_data()@\texttt{event\_data()}!plotly\_legenddoubleclick}
\index{event\_data()@\texttt{event\_data()}!event\_register()@\texttt{event\_register()}}

Drag selection events (i.e., `"plotly_selecting"`) are currently only available for 2D charts, but other common events are generally supported for any type of graph, including 3D charts. Figure \@ref(fig:3Devents) accesses various events in 3D including: `"plotly_hover"`, `"plotly_click"`, `"plotly_legendclick"`, `"plotly_legenddoubleclick"`, and `"plotly_relayout"`. The data emitted via `"plotly_hover"` and `"plotly_click"` is structured similarly to data emitted from `"plotly_selecting"`/`"plotly_selected"`. Figure \@ref(fig:3Devents) also demonstrates how one can react to particular components of a conflated event like `"plotly_relayout"`. That is, `"plotly_relayout"` will fire whenever _any_ part of the layout has changed, so if we want to trigger behavior if and only if there are changes to the camera eye, one could first check if the information emitted contains information about the camera eye.

```r
plotly_example("shiny", "event_data_3D")
```

```{r 3Devents, echo=FALSE, fig.cap = "(ref:3Devents)"}
include_vimeo("327600560", height = 500)
```

### Edit events

\index{Editable charts!Annotations}
\index{event\_data()@\texttt{event\_data()}!plotly\_relayout}

A little known fact about **plotly** is that you can directly manipulate annotations, title, shapes (e.g., circle, lines, rectangles), legends, and more by simply adding `config(p, editable = TRUE)` to a plot `p`. Moreover, since these are all layout components, we can access and respond to these 'edit events' by listening to the `"plotly_relayout"` events. Figure \@ref(fig:shiny-edit-annotations) demonstrates how display access information about changes in annotation positioning and content.

```{r eval = FALSE, summary = "Click to show/hide the code"}
library(shiny)

ui <- fluidPage(
  plotlyOutput("p"),
  verbatimTextOutput("info")
)

server <- function(input, output, session) {
  
  output$p <- renderPlotly({
    plot_ly() %>%
      layout(
        annotations = list(
          list(
            text = emo::ji("fire"),
            x = 0.5, 
            y = 0.5, 
            xref = "paper",
            yref = "paper",
            showarrow = FALSE
          ),
          list(
            text = "fire",
            x = 0.5, 
            y = 0.5, 
            xref = "paper",
            yref = "paper"
          )
        )) %>%
      config(editable = TRUE)
  })
  
  output$info <- renderPrint({
    event_data("plotly_relayout")
  })
  
}

shinyApp(ui, server)
```

```{r shiny-edit-annotations, echo=FALSE, fig.cap = "(ref:shiny-edit-annotations)"}
include_vimeo("307597631")
```

Figure \@ref(fig:shiny-drag-circle) demonstrates directly manipulating a circle shape and accessing the new positions of the circle. In contrast to Figure \@ref(fig:shiny-edit-annotations), which made everything (e.g., the plot and axis titles) editable via `config(p, editable = TRUE)`, note how Figure \@ref(fig:shiny-drag-circle) makes use of the `edits` argument to make only the shapes editable. 

\index{Editable charts!Circles}
\index{event\_data()@\texttt{event\_data()}!plotly\_relayout}
\index{layout()@\texttt{layout()}!shapes@\texttt{shapes}!Circles}

```{r eval = FALSE, summary = "Click to show/hide the code"}
library(shiny)

ui <- fluidPage(
  plotlyOutput("p"),
  verbatimTextOutput("event")
)

server <- function(input, output, session) {
  
  output$p <- renderPlotly({
    plot_ly() %>%
      layout(
        xaxis = list(range = c(-10, 10)),
        yaxis = list(range = c(-10, 10)),
        shapes = list(
          type = "circle", 
          fillcolor = "gray",
          line = list(color = "gray"),
          x0 = -10, x1 = 10,
          y0 = -10, y1 = 10,
          xsizemode = "pixel", 
          ysizemode = "pixel",
          xanchor = 0, yanchor = 0
        )
      ) %>%
      config(edits = list(shapePosition = TRUE))
  })
  
  output$event <- renderPrint({
    event_data("plotly_relayout")
  })
  
}

shinyApp(ui, server)
```

```{r shiny-drag-circle, echo=FALSE, fig.cap = "(ref:shiny-drag-circle)"}
include_vimeo("327619858")
```

Figure \@ref(fig:interactive-lm) demonstrates a linear model that reacts to edited circle shape positions using the `"plotly_relayout"` event in **shiny**. This interactive tool is an effective way to visualize the impact of high leverage points on a linear model fit. The main idea is to have the model fit (as well as its summary and predicted values) depend on the current state of x and y values, which here is stored and updated via `reactiveValues()`. Section \@ref(reactive-vals) has more examples of using reactive values to maintain state within a **shiny** application.

```r
plotly_example("shiny", "drag_markers")
```

```{r interactive-lm, echo=FALSE, fig.cap = "(ref:interactive-lm)"}
include_vimeo("318338029")
```

Figure \@ref(fig:shiny-drag-line) uses an editable vertical line and the `plotly_relayout` event data to 'snap' the line to the closest point in a sequence of `x` values. It also places a marker on the intersection between the vertical line shape and the line chart of `y` values. Notice how, by accessing `event_data()` in this way (i.e., the source and target view of the event is the same), the chart is actually fully redrawn every time the line shape moves. If performance were an issue (i.e., we were dealing with lots of lines), this type of interaction likely won't be very responsive. In that case, you can use `event_data()` to trigger side effects (i.e., partially modify the plot) which is covered in Section \@ref(proxies).

\index{Editable charts!Lines}
\index{event\_data()@\texttt{event\_data()}!plotly\_relayout}
\index{layout()@\texttt{layout()}!shapes@\texttt{shapes}!Lines}

```r
plotly_example("shiny", "drag_lines")
```

```{r shiny-drag-line, echo=FALSE, fig.cap = "(ref:shiny-drag-line)"}
include_vimeo("307597984")
```

### Relayout vs. restyle events

\index{Chart types!Parallel coordinates}
\index{event\_data()@\texttt{event\_data()}!plotly\_restyle}

Remember every **graph** has two critical components: data (i.e., traces) and layout. Similar to how `"plotly_relayout"` reports partial modifications to the layout, the `"plotly_restyle"` event reports partial modification to traces. Compared to `"plotly_relayout"`, there aren't very many native direct manipulation events that would trigger a `"plotly_restyle"` event. For example, zoom/pan events, camera changes, editing annotations/shapes/etc. all trigger a `"plotly_relayout"` event, but not many traces allow you to directly manipulate their properties. One notable exception is the `"parcoords"` trace type which has native support for brushing lines along an axis dimension(s). As Figure \@ref(fig:shiny-parcoords) demonstrates, these brush events emit a `"plotly_restyle"` event with the range(s) of the highlighted dimension.

```{r eval = FALSE, summary = "Click to show/hide the code"}
library(shiny)

ui <- fluidPage(
  plotlyOutput("parcoords"),
  verbatimTextOutput("info")
)

server <- function(input, output, session) {
  
  d <- dplyr::select_if(iris, is.numeric)
  
  output$parcoords <- renderPlotly({
    
    dims <- Map(function(x, y) {
      list(
        values = x, 
        range = range(x, na.rm = TRUE), 
        label = y
      )
    }, d, names(d), USE.NAMES = FALSE)
    
    plot_ly() %>%
      add_trace(
        type = "parcoords",
        dimensions = dims
      ) %>%
      event_register("plotly_restyle")
  })
  
  output$info <- renderPrint({
    d <- event_data("plotly_restyle")
    if (is.null(d)) "Brush along a dimension" else d
  })
  
}

shinyApp(ui, server)
```

```{r shiny-parcoords, echo=FALSE, fig.cap = '(ref:shiny-parcoords)'}
include_vimeo("327623322")
```

As Figure \@ref(fig:shiny-parcoords-data) shows, it's possible to use this information to infer which data points are highlighted. The logic to do so is fairly sophisticated and requires accumulation of the event data, as discussed in Section \@ref(reactive-vals).

```r
plotly_example("shiny", "event_data_parcoords")
```

```{r shiny-parcoords-data, echo=FALSE, fig.cap = "(ref:shiny-parcoords-data)"}
include_vimeo("307598128")
```

### Scoping events {#scoping-events}

\index{event\_data()@\texttt{event\_data()}!Scoping events}

This section leverages the interface for accessing **plotly** input events introduced in Section \@ref(shiny-plotly-inputs) to inform other data views about those events. When managing multiple views that communicate with one another, you'll need to be aware of which views are a *source* of interaction and which are a *target* (a view can be both, at once!). The `event_data()` function provides a `source` argument to help refine which view(s) serve as the source of an event. The `source` argument takes a string ID, and when that ID matches the `source` of a `plot_ly()`/`ggplotly()` graph, then the `event_data()` is "scoped" to that view. To get a better idea of how this works, consider Figure \@ref(fig:shiny-corrplot).

Figure \@ref(fig:shiny-corrplot) allows one to click on a cell of correlation heatmap to generate a scatterplot of the two corresponding variables, allowing for a closer look at their relationship. In the case of a heatmap, the event data tied to a `plotly_click` event contains the relevant `x` and `y` categories (e.g., the names of the data variables of interest) and the `z` value (e.g., the pearson correlation between those variables). In order to obtain click data from the heatmap, and only the heatmap, it's important that the `source` argument of the `event_data()` function matches the `source` argument of `plot_ly()`. Otherwise, if the `source` argument was not specified `event_data("plotly_click")` would also fire if and when the user clicked on the scatterplot, likely causing an error.

```{r eval = FALSE, summary = "Click to show/hide the code"}
library(shiny)

# cache computation of the correlation matrix
correlation <- round(cor(mtcars), 3)

ui <- fluidPage(
  plotlyOutput("heat"),
  plotlyOutput("scatterplot")
)

server <- function(input, output, session) {
  
  output$heat <- renderPlotly({
    plot_ly(source = "heat_plot") %>%
      add_heatmap(
        x = names(mtcars), 
        y = names(mtcars), 
        z = correlation
      )
  })
  
  output$scatterplot <- renderPlotly({
    # if there is no click data, render nothing!
    clickData <- event_data("plotly_click", source = "heat_plot")
    if (is.null(clickData)) return(NULL)
    
    # Obtain the clicked x/y variables and fit linear model
    vars <- c(clickData[["x"]], clickData[["y"]])
    d <- setNames(mtcars[vars], c("x", "y"))
    yhat <- fitted(lm(y ~ x, data = d))
    
    # scatterplot with fitted line
    plot_ly(d, x = ~x) %>%
      add_markers(y = ~y) %>%
      add_lines(y = ~yhat) %>%
      layout(
        xaxis = list(title = clickData[["x"]]), 
        yaxis = list(title = clickData[["y"]]), 
        showlegend = FALSE
      )
  })
  
}

shinyApp(ui, server)
```

```{r shiny-corrplot, echo=FALSE, fig.cap="(ref:shiny-corrplot)"}
include_vimeo("307597728")
```

### Event priority

\index{event\_data()@\texttt{event\_data()}!Event priority}

By default, `event_data()` only invalidates a reactive expression when the value of its corresponding **shiny** input changes. Sometimes, you might want a particular event, say `"plotly_click"`, to _always_ invalidate a reactive expression. Figure \@ref(fig:event-priority) shows the difference between this default behavior versus setting `priority = 'event'`. By default, repeatedly clicking the same marker won't update the clock, but when setting the `priority` argument to event, repeatedly clicking the same marker will update the clock (i.e., it will invalidate the reactive expression).

```{r eval = FALSE, summary = "Click to show/hide the code"}
library(shiny)

ui <- fluidPage(
  plotlyOutput("p"),
  textOutput("time1"),
  textOutput("time2")
)

server <- function(input, output, session) {
  
  output$p <- renderPlotly({
    plot_ly(x = 1:2, y = 1:2, size = I(c(100, 150)))  %>%
      add_markers()
  })
  
  output$time1 <- renderText({
    event_data("plotly_click")
    paste("Input priority: ", Sys.time())
  })
  
  output$time2 <- renderText({
    event_data("plotly_click", priority = "event")
    paste("Event priority: ", Sys.time())
  })
  
}

shinyApp(ui, server)
```

```{r event-priority, echo=FALSE, fig.cap = "(ref:event-priority)"}
include_vimeo("307598534")
```

There are numerous events accessible through `event_data()` that don't contain any information (e.g., `"plotly_doubleclick"`, `"plotly_deselect"`, `"plotly_afterplot"`, etc.). These events are automatically given an event priority since their corresponding **shiny** input value never changes. One common use case for events like `"plotly_doubleclick"` (fired when double-clicking in a zoom or pan dragmode) and `"plotly_deselect"` (fired when double-clicking in a selection mode) is to clear or reset accumulating event data.

### Handling discrete axes

\index{event\_data()@\texttt{event\_data()}!customdata@\texttt{customdata}}

For events that are trace-specific (e.g., `"plotly_click"`, `"plotly_hover"`, `"plotly_selecting"`, etc.), the positional data (e.g., `x`/`y`/`z`) is always numeric, so if you have a plot with discrete axes, you might want to know how to map that numeric value back to the relevant input data category. In some cases, you can avoid the problem by assigning the discrete variable of interest to the `key`/`customdata` attribute, but you might also want to reserve that attribute to encode other information, like a `fill` aesthetic. Figure \@ref(fig:discrete-event-data) shows how to map the numerical `x` value emitted in a click event back to the discrete variable that it corresponds to (`mpg$class`) and leverages `customdata` to encode the `fill` mapping allowing us to display the data records a clicked bar corresponds to. In both `ggplotly()` and `plot_ly()`, categories associated with a character vector are always alphabetized, so if you `sort()` the `unique()` character values, then the vector indices will match the `x` event data values. On the other hand, if `x` were a factor variable, the `x` event data would match the ordering of the `levels()` attribute.

```{r eval = FALSE, summary = "Click to show/hide the code"}
library(shiny)
library(dplyr)

ui <- fluidPage(
  plotlyOutput("bars"),
  verbatimTextOutput("click")
)

classes <- sort(unique(mpg$class))

server <- function(input, output, session) {
  
  output$bars <- renderPlotly({
    ggplot(mpg, aes(class, fill = drv, customdata = drv)) +
      geom_bar()
  })
  
  output$click <- renderPrint({
    d <- event_data("plotly_click")
    if (is.null(d)) return("Click a bar")
    mpg %>%
      filter(drv %in% d$customdata) %>%
      filter(class %in% classes[d$x])
  })
  
}

shinyApp(ui, server)
```

```{r discrete-event-data, echo=FALSE, fig.cap = "(ref:discrete-event-data)"}
include_vimeo("307598771")
```

### Accumulating and managing event data {#reactive-vals}

\index{event\_data()@\texttt{event\_data()}!Manage state@Manage state with \texttt{reactiveVal()}}

Currently all the events accessible through `event_data()` are *transient*. This means that, given an event like `"plotly_click"`, the value of `event_data()` will only reflect the most recent click information. However, in order to implement complex linked graphics with *persistent* qualities, like Figure \@ref(fig:txmissing-modes) or \@ref(fig:shiny-crossfilter), you'll need some way to accumulate and manage event data. The general mechanism that **shiny** provides to achieve this kind of task is `reactiveVal()` (or, the plural version, `reactiveValues()`), which essentially provides a way to create and manage input values entirely server-side.

Figure \@ref(fig:shiny-hover-persist) demonstrates a shiny app that accumulates hover information and paints the hovered points in red. Every time a hover event is triggered, the corresponding car name is added to the set of selected cars, and every time the plot is double-clicked that set is cleared. This general pattern of initializing a reactive value (i.e., `cars <- reactiveVal()`), updating that value upon a suitable `observeEvent()` event with relevant `customdata`, and clearing that reactive value (i.e., `cars(NULL)`) in response to another event is a very useful pattern to support essentially any sort of linked views paradigm because the logic behind the resolution of selection sequences is under your complete control in R. For example, Figure \@ref(fig:shiny-hover-persist) simply accumulates the event data from `"plotly_hover"` (which is like a logical `OR` operations), but for other applications, you may need different logic, like the `AND`, `XOR`, etc.

```r
plotly_example("shiny", "event_data_persist")
```

```{r shiny-hover-persist, echo=FALSE, fig.cap = "(ref:shiny-hover-persist)"}
include_vimeo("307597677")
```

Figure \@ref(fig:shiny-lmGadget) demonstrates a **shiny** gadget for interactively removing/adding points from a linear model via a scatterplot. A **shiny** gadget is similar to a normal **shiny** app except that it allows you to return object(s) from the application back to into your R session. In this case, Figure \@ref(fig:shiny-lmGadget) returns the fitted model with the outliers removed and the chosen polynomial degree. The logic behind this app does more than simply accumulate event data every time a point is clicked. Instead, it adds points to the 'outlier' set only if it isn't already an outlier, and removes points that are already in the "outlier" set (so, it's essentially `XOR` logic). 

```r
plotly_example("shiny", "lmGadget")
```

```{r shiny-lmGadget, echo=FALSE, fig.cap = "(ref:shiny-lmGadget)"}
include_vimeo("307598908")
```

As you can already see, the ability to accumulate and manage event data is a critical skill to have in order to implement **shiny** applications with complex interactive capabilities. The pattern demonstrated here is known more generally as "maintaining state" of a **shiny** app based on user interactions and has a variety of applications. So far, we've really only seen how to maintain state of a single view, but as we'll see later in Section \@ref(advanced-applications), the ability to maintain state is required to implement many advanced applications of multiple linked views. Also, it should be noted that Figures \@ref(fig:shiny-hover-persist) and \@ref(fig:shiny-lmGadget) perform a full redraw when updated; these apps would feel a bit more responsive if they leveraged strategies from Section \@ref(proxies).


## Improving performance {#shiny-performance}

Multiple linked views are known to help facilitate data exploration, but latency in the user interface is also known to reduce exploratory findings [@2014-latency]. In addition to the advice and techniques offered in Section \@ref(proxies) for improving **plotly**'s performance in general, there are also techniques specifically for **shiny** apps that you can leverage to help improve the user experience. 

When trying to speed up any slow code, the first step is always to identify the main contributor(s) to the poor performance. In some cases, your intuition may serve as a helpful guide, but in order to *really* see what's going on, consider using a code profiling tool like **profvis** [@profvis]. The **profvis** package provides a really nice way to visualize and isolate slow running R code in general, but it also works well for profiling **shiny** apps [@profvis-shiny]. 

A lot of different factors can contribute to poor performance in a **shiny** app, but thankfully, the **shiny** ecosystem provides an extensive toolbox for diagnosing and improving performance. The **profvis** package is great for identifying "universal" performance issues, but when deploying shiny apps into production, there may be other potential bottlenecks that surface. This is largely due to R's single-threaded nature -- a single R server has difficulty scaling to many users because, by default, it can only handle one job at a time. The  **shinyloadtest** package helps to identify those bottlenecks and **shiny**'s support for asynchronous programming with **promises** is one way to address them without increasing computational infrastructure (e.g., multiple servers) [@shinyloadtest; @promises].

To reiterate the section on "Improving performance and scalability" in **shiny** from @async, you have a number of tools available to address performance:

1. The **profvis** package for profiling code.
2. Cache computations ahead-of-time.
3. Cache computations at run time.
4. Cache computations through chaining reactive expressions.
5. Leverage multiple R processes and/or servers.
6. Async programming with **promises**.

We won't directly cover these topics, but it's worth noting that all these tools are primarily designed for improving _server-side_ performance of a **shiny** app. It could be that sluggish plots in your **shiny** app are due to sluggish server-side code, but it could also be that some of the sluggishness is due to redundant work being done client-side by **plotly**. Avoiding this redundancy, as covered in Section \@ref(proxies), can be difficult, and it doesn't always lead to noticeable improvements. However, when you need to put lots of graphical elements on a plot, then update just a portion of the plot in response to user event(s), the added complexity can be worth the effort.

### Partial plotly updates {#proxies}

\index{plotlyProxy()@\texttt{plotlyProxy()}|seealso {plotlyProxyInvoke()}}
\index{plotlyProxyInvoke()@\texttt{plotlyProxyInvoke()}}

By default, when `renderPlotly()` renders a new **plotly** graph, it's essentially equivalent to executing a block of R code from your R prompt and generating a new **plotly** graph from scratch. That means, not only does the R code need to re-execute to generate a new R object, but it also has to re-serialize that object as JSON, and your browser has to re-render the graph from the new JSON object (more on this in Chapter \@ref(performance)). In cases where your **plotly** graph does not need to serialize a lot of data and/or render lots of graphical elements, as in Figure \@ref(fig:shiny-intro), you can likely perform a full redraw without noticeable glitches, especially if you use Canvas-based rendering rather than SVG (i.e., `toWebGL()`). Generally speaking, you should try very hard to make your app responsive before adopting partial **plotly** updates in **shiny**. It makes your app logic easy to reason about because you don't have to worry about maintaining the state of the graph, but sometimes you have no other choice.

On initial page load, **plotly** graphs must be drawn from stratch, but when responding to certain user events, often a partial update to an existing plot is sufficient and more responsive. Take, for instance, the difference between Figure \@ref(fig:shiny-scatterplot), which does a full redraw on every update, and Figure \@ref(fig:shiny-scatterplot-performant), which does a partial update after initial load. Both of these **shiny** apps display a scatterplot with 100,000 points and allow a user to overlay a fitted line through a checkbox. The key difference is that in Figure \@ref(fig:shiny-scatterplot), the **plotly** graph is regenerated from scratch every time the value of `input$smooth` changes; whereas in Figure \@ref(fig:shiny-scatterplot-performant) only the fitted line is added/removed from the **plotly**. Since the main bottleneck lies in redrawing the points, Figure \@ref(fig:shiny-scatterplot-performant) can add/remove the fitted line in a much more responsive fashion.

\index{toWebGL()@\texttt{toWebGL()}!plot\_ly()@\texttt{plot\_ly()}}

```{r eval = FALSE, summary = "Click to show/hide the code"}
library(shiny)
library(plotly)

# Generate 100,000 observations from 2 correlated random variables
s <- matrix(c(1, 0.5, 0.5, 1), 2, 2)
d <- MASS::mvrnorm(1e6, mu = c(0, 0), Sigma = s)
d <- setNames(as.data.frame(d), c("x", "y"))

# fit a simple linear model
m <- lm(y ~ x, data = d)

# generate y predictions over a grid of 10 x values
dpred <- data.frame(
  x = seq(min(d$x), max(d$x), length.out = 10)
)
dpred$yhat <- predict(m, newdata = dpred)

ui <- fluidPage(
  plotlyOutput("scatterplot"),
  checkboxInput(
    "smooth", 
    label = "Overlay fitted line?", 
    value = FALSE
  )
)

server <- function(input, output, session) {
  
  output$scatterplot <- renderPlotly({
    
    p <- plot_ly(d, x   = ~x, y = ~y) %>%
      add_markers(color = I("black"), alpha = 0.05) %>%
      toWebGL() %>%
      layout(showlegend = FALSE)
    
    if (!input$smooth) return(p)
    
    add_lines(p, data = dpred, x = ~x, y = ~yhat, color = I("red"))
  })
  
}

shinyApp(ui, server)
```

```{r shiny-scatterplot, echo=FALSE, fig.cap="(ref:shiny-scatterplot)"}
include_vimeo("327620506")
```

In terms of the implementation behind Figures \@ref(fig:shiny-scatterplot) and \@ref(fig:shiny-scatterplot-performant), the only difference resides in the `server` definition. In Figure \@ref(fig:shiny-scatterplot-performant), the `renderPlotly()` statement no longer has a dependency on input values, so that code is only executed once (on page load) to generate the initial view of the scatterplot. The logic behind adding and removing the fitted line is handled through an `observe()` block; this reactive expression watches the `input$smooth` input value and modifies the `output$scatterplot` widget whenever it changes. To trigger a modification of a **plotly** output widget, you must create a proxy object with `plotlyProxy()` that references the relevant output ID. Once a proxy object is created, you can invoke any sequence of [plotly.js function(s)](https://plot.ly/javascript/plotlyjs-function-reference/#plotlymaketemplate) on it with `plotlyProxyInvoke()`. Invoking a method with the correct arguments can be tricky and requires knowledge of plotly.js because `plotlyProxyInvoke()` will send these arguments directly to the plotly.js method and therefore doesn't support the same 'high-level' semantics that `plot_ly()` does.

\index{plotlyProxyInvoke()@\texttt{plotlyProxyInvoke()}!addTraces@\texttt{addTraces}}
\index{plotlyProxyInvoke()@\texttt{plotlyProxyInvoke()}!deleteTraces@\texttt{deleteTraces}}


```{r eval = FALSE, summary = "Click to show/hide the code"}
server <- function(input, output, session) {
  
  output$scatterplot <- renderPlotly({
    plot_ly(d, x = ~x, y = ~y) %>%
      add_markers(color = I("black"), alpha = 0.05) %>%
      toWebGL()
  })
  
  observe({
    if (input$smooth) {
      # this is essentially the plotly.js way of doing
      # `p %>% add_lines(x = ~x, y = ~yhat) %>% toWebGL()`
      # without having to redraw the entire plot
      plotlyProxy("scatterplot", session) %>%
        plotlyProxyInvoke(
          "addTraces", 
          list(
            x = dpred$x,
            y = dpred$yhat,
            type = "scattergl",
            mode = "lines",
            line = list(color = "red")
          )
        )
    } else {
      # JavaScript index starts at 0, so the '1' here really means
      # "delete the second traces (i.e., the fitted line)"
      plotlyProxy("scatterplot", session) %>%
        plotlyProxyInvoke("deleteTraces", 1)
    }
  })
}
```

```{r shiny-scatterplot-performant, echo=FALSE, fig.cap="(ref:shiny-scatterplot-performant)"}
include_vimeo("327621124")
```

Figure \@ref(fig:shiny-scatterplot) demonstrates a common use case where partial updates can be helpful, but there are other not-so-obvious cases. The next section covers a range of examples where you'll see how to leverage partial updates to implement smooth 'streaming' visuals, avoid resetting axis ranges, avoid flickering basemap layers, and more.

### Partial update examples

The last section explains why you may want to leverage partial **plotly** updates in **shiny** to get more responsive updates through an example. That example leveraged the [plotly.js functions](https://plot.ly/javascript/plotlyjs-function-reference/) `Plotly.addTraces()` and `Plotly.deleteTraces()` to add/remove a layer to a plot after its initial draw. There are numerous other plotly.js functions that can be handy for a variety of use cases, some of the most widely used ones are: `Plotly.restyle()` for updating data visuals (Section \@ref(restyle)), `Plotly.relayout()` for updating the layout (Section \@ref(relayout)), and `Plotly.extendTraces()` for streaming data (Section \@ref(streaming)).

#### Modifying traces {#restyle}

\index{plotlyProxyInvoke()@\texttt{plotlyProxyInvoke()}!restyle@\texttt{restyle}}

All **plotly** figures have two main components: traces (i.e., mapping from data to visuals) and layout. The plotly.js function `Plotly.restyle()` is for modifying any existing traces. In addition to being a performant way to modify existing data and/or visual properties, it also has the added benefit of not affecting the current layout of the graph. Notice how, in Figure \@ref(fig:shiny-partial-restyle) for example, when the size of the marker/path changes, it doesn't change the camera's view of the 3D plot that the user altered after initial draw. If these input widgets triggered a full redraw of the plot, the camera would be reset to its initial state.

```r
plotly_example("shiny", "proxy_restyle_economics")
```

```{r shiny-partial-restyle, echo = FALSE, fig.cap="(ref:shiny-partial-restyle)"}
include_vimeo("327621625")
```

One un-intuitive thing about `Plotly.restyle()` is that it fully replaces object (i.e., attributes that contain attributes) definitions like `marker` by default. To modify just a particular attribute of an object, like the size of a marker, you must replace that attribute directly (hence `marker.size`). As mentioned in the [official documentation](https://plot.ly/javascript/plotlyjs-function-reference/#plotlyrestyle), by default, modifications are applied to all traces, but specific traces can be targeted through their trace index (which starts at 0, because of JavaScript)!


#### Updating the layout {#relayout}

\index{plotlyProxyInvoke()@\texttt{plotlyProxyInvoke()}!relayout@\texttt{relayout}}

All **plotly** figures have two main components: traces (i.e., mapping from data to visuals) and layout. The plotly.js function `Plotly.relayout()` modifies the layout component, so it can control a wide variety of things such as titles, axis definitions, annotations, shapes, and many other things. It can even be used to change the basemap layer of a Mapbox-powered layout, as in Figure \@ref(fig:shiny-mapbox-relayout). Note how this example uses `schema()` to grab all the pre-packaged basemap layers and create a dropdown of those options, but you can also provide a URL to a [custom basemap style](https://www.mapbox.com/help/create-a-custom-style/).

```r
plotly_example("shiny", "proxy_mapbox")
```

```{r shiny-mapbox-relayout, echo = FALSE, fig.cap="(ref:shiny-mapbox-relayout)"}
include_vimeo("327603568")
```

Figure \@ref(fig:shiny-rangeslider-relayout) demonstrates a clever use of `Plotly.relayout()` to set the y-axis range in response to changes in the x-axis range.

\indexc{rangeslider()}

```r
plotly_example("shiny", "proxy_relayout")
```

```{r shiny-rangeslider-relayout, echo = FALSE, fig.cap="(ref:shiny-rangeslider-relayout)"}
include_vimeo("307598689")
```


#### Streaming data {#streaming}

\index{plotlyProxyInvoke()@\texttt{plotlyProxyInvoke()}!extendTraces@\texttt{extendTraces}}

At this point, we've seen how to add/remove traces (e.g., add/remove a fitted line, as in Figure \@ref(fig:shiny-scatterplot-performant)), and how to edit specific trace properties (e.g., change marker size or path width, as in Figure \@ref(fig:shiny-partial-restyle)), but what about adding more data to existing trace(s)? This is a job for the plotly.js function `Plotly.extendTraces()` and/or `Plotly.prependTraces()` which can be used to efficiently 'stream' data into an existing plot, as done in Figure \@ref(fig:shiny-stream).

The implementation behind Figure \@ref(fig:shiny-stream), an elementary example of a random walk, makes use of some fairly sophisticated reactive programming tools from **shiny**. Similar to most examples from this section, the `renderPlotly()` statement is executed once on initial load to draw the initial line with just two data points. By default, the plot is not streaming, but  streaming can be turned on or off through the click of a button, which will require the app to know (at all times) whether or not we are in a streaming state. One way to do this is to leverage **shiny**'s `reactiveValues()`, which act like input values, but can be created and modified entirely server-side, making them quite useful for maintaining the state of an application. In this case, the reactive value `rv$stream` is used to store the streaming state, which is turned on/off whenever the `actionButton()` is clicked (via the `observeEvent()` logic).

Even if the app is not streaming, there is still constant client/server communication because of the use of `invalidateLater()` inside the `observe()`. This effectively tells **shiny** to re-evaluate the `observe()` block every 100 milliseconds. If the app isn't in streaming mode, then it exits early without doing anything. If the app is streaming, then we first use `sample()` to randomly draw either -1 or 1 (with equal probability) and use the result to update the most recent (x, y) state. This is done by assigning a new value to the reactive values `rv$y` and `rv$n` within an `isolate()`d context. If this assignment happened outside of an `isolate()`d context, it would cause the reactive expression to be invalidated and cause an infinite loop! Once we have the new (x, y) point stored away, `Plotly.extendTraces()` can be used to add the new point to the plotly graph.


```r
plotly_example("shiny", "stream")
```

```{r shiny-stream, echo = FALSE, fig.cap="(ref:shiny-stream)"}
include_vimeo("307598387")
```

To see more examples that leverage partial updating, see Section \@ref(crossfilter).

## Advanced applications {#advanced-applications}

This section combines concepts from prior sections in linking views with shiny and applies them towards some popular use cases.

### Drill-down

Figure \@ref(fig:shiny-drill-down-pie) displays sales broken down by business category (e.g., Furniture, Office Supplies, Technology) in a pie chart. It allows the user to click on a slice of the pie to 'drill-down' into sub-categories of the chosen category. In terms of the implementation, the key aspect here is to maintain the state of the currently selected category via a `reactiveVal()` (see more in Section \@ref(reactive-vals)) and update that value when either a category is clicked or the "Back" button is pressed. This may seem like a lot of code to get a basic drill-down pie chart, but the core reactivity concepts in this implementation translate well to more complex drill-down applications.

\index{add\_trace()@\texttt{add\_trace()}!add\_pie()@\texttt{add\_pie()}}
\index{event\_data()@\texttt{event\_data()}!plotly\_click}
\index{event\_data()@\texttt{event\_data()}!customdata@\texttt{customdata}}


```{r eval = FALSE, summary = "Click to show/hide the code"}
library(shiny)
library(dplyr)
library(readr)
library(purrr) # just for `%||%`

sales <- read_csv("https://plotly-r.com/data-raw/sales.csv")
categories <- unique(sales$category)

ui <- fluidPage(plotlyOutput("pie"), uiOutput("back"))

server <- function(input, output, session) {
  # for maintaining the current category (i.e., selection)
  current_category <- reactiveVal()
  
  # report sales by category, unless a category is chosen
  sales_data <- reactive({
    if (!length(current_category())) {
      return(count(sales, category, wt = sales))
    }
    sales %>%
      filter(category %in% current_category()) %>%
      count(sub_category, wt = sales)
  })
  
  # Note that pie charts don't currently attach the label/value 
  # with the click data, but we can include as `customdata`
  output$pie <- renderPlotly({
    d <- setNames(sales_data(), c("labels", "values"))
    plot_ly(d) %>%
      add_pie(
        labels = ~labels, 
        values = ~values, 
        customdata = ~labels
      ) %>%
      layout(title = current_category() %||% "Total Sales")
  })
  
  # update the current category when appropriate
  observe({
    cd <- event_data("plotly_click")$customdata[[1]]
    if (isTRUE(cd %in% categories)) current_category(cd)
  })
  
  # populate back button if category is chosen
  output$back <- renderUI({
    if (length(current_category())) 
      actionButton("clear", "Back", icon("chevron-left"))
  })
  
  # clear the chosen category on back button press
  observeEvent(input$clear, current_category(NULL))
}

shinyApp(ui, server)
```

```{r shiny-drill-down-pie, echo=FALSE, fig.cap="(ref:shiny-drill-down-pie)"}
include_vimeo("328763167")
```

A basic drill-down like Figure \@ref(fig:shiny-drill-down-pie) is somewhat useful on its own, but it becomes much more useful when linked to multiple views of the data. Figure \@ref(fig:shiny-drill-down-bar-time) improves on Figure \@ref(fig:shiny-drill-down-pie) to show sales over time by the category or sub-category (if a category is currently chosen). Note that the key aspect of implementation remains the same (i.e., maintaining state via `reactiveValue()`); the main difference is that the time series view now also responds to changes in the currently selected category. That is, both views show sales by category when no category is selected, and sales by sub-category when a category is selected.

\index{event\_data()@\texttt{event\_data()}!plotly\_click}

```{r eval = FALSE, summary = "Click to show/hide the code"}
library(shiny)
library(dplyr)
library(readr)

sales <- read_csv("https://plotly-r.com/data-raw/sales.csv")
categories <- unique(sales$category)

ui <- fluidPage(
  plotlyOutput("bar"),
  uiOutput("back"),
  plotlyOutput("time")
)

server <- function(input, output, session) {
  
  current_category <- reactiveVal()
  
  # report sales by category, unless a category is chosen
  sales_data <- reactive({
    if (!length(current_category())) {
      return(count(sales, category, wt = sales))
    }
    sales %>%
      filter(category %in% current_category()) %>%
      count(sub_category, wt = sales)
  })
  
  # the pie chart
  output$bar <- renderPlotly({
    d <- setNames(sales_data(), c("x", "y"))
    
    plot_ly(d) %>%
      add_bars(x = ~x, y = ~y, color = ~x) %>%
      layout(title = current_category() %||% "Total Sales")
  })
  
  # same as sales_data
  sales_data_time <- reactive({
    if (!length(current_category())) {
      return(count(sales, category, order_date, wt = sales))
    }
    sales %>%
      filter(category %in% current_category()) %>%
      count(sub_category, order_date, wt = sales)
  })
  
  output$time <- renderPlotly({
    d <- setNames(sales_data_time(), c("color", "x", "y"))
    plot_ly(d) %>%
      add_lines(x = ~x, y = ~y, color = ~color)
  })
  
  # update the current category when appropriate
  observe({
    cd <- event_data("plotly_click")$x
    if (isTRUE(cd %in% categories)) current_category(cd)
  })
  
  # populate back button if category is chosen
  output$back <- renderUI({
    if (length(current_category())) 
      actionButton("clear", "Back", icon("chevron-left"))
  })
  
  # clear the chosen category on back button press
  observeEvent(input$clear, current_category(NULL))
}

shinyApp(ui, server)
```

```{r shiny-drill-down-bar-time, echo=FALSE, fig.cap="(ref:shiny-drill-down-bar-time)"}
include_vimeo("328768848")
```

Figures \@ref(fig:shiny-drill-down-pie) and \@ref(fig:shiny-drill-down-bar-time) demonstrate one level of drill-down; what about multiple levels? Introducing multiple levels adds complexity not only to the implementation, but also the user experience. Especially in a drill-down approach where the _same view_ is being filtered, it can be difficult for users to remember how they got to a particular view. Figure \@ref(fig:shiny-drill-down-bar-time-history) demonstrates how we could extend Figure \@ref(fig:shiny-drill-down-bar-time) to implement yet another level of drilling down (i.e., category -> sub-category -> product IDs) as well as populate a `selectInput()` dropdown for each active drill-down category. Not only does this help users to remember how they got to the particular view, but it also provides the ability to easily modify the sequence of drill-down events. In terms of implementation, the main idea is very similar to before: we still store and update the state of each 'drill-down' in its own reactive value, but now when a 'parent' category changes (e.g., `category`) it should invalidate (i.e., clear) any currently selected 'child' categories (e.g., `sub_category`).

\index{event\_data()@\texttt{event\_data()}!plotly\_click}
\index{add\_trace()@\texttt{add\_trace()}!add\_table()@\texttt{add\_table()}}

```{r, eval = FALSE, summary = "Click to show/hide the code"}
library(shiny)
library(plotly)
library(dplyr)
library(readr)

sales <- read_csv("https://plotly-r.com/data-raw/sales.csv")
categories <- unique(sales$category)
sub_categories <- unique(sales$sub_category)
ids <- unique(sales$id)

ui <- fluidPage(
  uiOutput("history"),
  plotlyOutput("bars", height = 200),
  plotlyOutput("lines", height = 300)
)

server <- function(input, output, session) {
  # These reactive values keep track of the drilldown state
  # (NULL means inactive)
  drills <- reactiveValues(
    category = NULL,
    sub_category = NULL,
    id = NULL
  )
  # filter the databased on active drill-downs
  # also create a column, value, which keeps track of which
  # variable we're interested in 
  sales_data <- reactive({
    if (!length(drills$category)) {
      return(mutate(sales, value = category))
    }
    sales <- filter(sales, category %in% drills$category)
    if (!length(drills$sub_category)) {
      return(mutate(sales, value = sub_category))
    }
    sales <- filter(sales, sub_category %in% drills$sub_category)
    mutate(sales, value = id)
  })
  
  # bar chart of sales by 'current level of category'
  output$bars <- renderPlotly({
    d <- count(sales_data(), value, wt = sales)
    
    p <- plot_ly(d, x = ~value, y = ~n, source = "bars") %>%
      layout(
        yaxis = list(title = "Total Sales"), 
        xaxis = list(title = "")
      )
    
    if (!length(drills$sub_category)) {
      add_bars(p, color = ~value)
    } else if (!length(drills$id)) {
      add_bars(p) %>%
        layout(
          hovermode = "x",
          xaxis = list(showticklabels = FALSE)
        )
    } else {
      # add a visual cue of which ID is selected
      add_bars(p) %>%
        filter(value %in% drills$id) %>%
        add_bars(color = I("black")) %>%
        layout(
          hovermode = "x", xaxis = list(showticklabels = FALSE),
          showlegend = FALSE, barmode = "overlay"
        )
    }
  })
  
  # time-series chart of the sales
  output$lines <- renderPlotly({
    p <- if (!length(drills$sub_category)) {
      sales_data() %>%
        count(order_date, value, wt = sales) %>%
        plot_ly(x = ~order_date, y = ~n) %>%
        add_lines(color = ~value)
    } else if (!length(drills$id)) {
      sales_data() %>%
        count(order_date, wt = sales) %>%
        plot_ly(x = ~order_date, y = ~n) %>%
        add_lines()
    } else {
      sales_data() %>%
        filter(id %in% drills$id) %>%
        select(-value) %>%
        plot_ly() %>% 
        add_table()
    }
    p %>%
      layout(
        yaxis = list(title = "Total Sales"), 
        xaxis = list(title = "")
      )
  })
  
  # control the state of the drilldown by clicking the bar graph
  observeEvent(event_data("plotly_click", source = "bars"), {
    x <- event_data("plotly_click", source = "bars")$x
    if (!length(x)) return()
    
    if (!length(drills$category)) {
      drills$category <- x
    } else if (!length(drills$sub_category)) {
      drills$sub_category <- x
    } else {
      drills$id <- x
    }
  })
  
  # populate a `selectInput()` for each active drilldown 
  output$history <- renderUI({
    if (!length(drills$category)) 
      return("Click the bar chart to drilldown")
    
    categoryInput <- selectInput(
      "category", "Category", 
      choices = categories, selected = drills$category
    )
    if (!length(drills$sub_category)) return(categoryInput)
    sd <- filter(sales, category %in% drills$category)
    subCategoryInput <- selectInput(
      "sub_category", "Sub-category", 
      choices = unique(sd$sub_category), 
      selected = drills$sub_category
    )
    if (!length(drills$id)) {
      return(fluidRow(
        column(3, categoryInput), 
        column(3, subCategoryInput)
      ))
    }
    sd <- filter(sd, sub_category %in% drills$sub_category)
    idInput <- selectInput(
      "id", "Product ID", 
      choices = unique(sd$id), selected = drills$id
    )
    fluidRow(
      column(3, categoryInput), 
      column(3, subCategoryInput),
      column(3, idInput)
    )
  })
  
  # control the state of the drilldown via the `selectInput()`s
  observeEvent(input$category, {
    drills$category <- input$category
    drills$sub_category <- NULL
    drills$id <- NULL
  })
  observeEvent(input$sub_category, {
    drills$sub_category <- input$sub_category
    drills$id <- NULL
  })
  observeEvent(input$id, {
    drills$id <- input$id
  })
}

shinyApp(ui, server)
```

```{r shiny-drill-down-bar-time-history, echo=FALSE, fig.cap="(ref:shiny-drill-down-bar-time)"}
include_vimeo("328770954")
```

Another way to make it easier for the user to recall their drill-down sequence is to generate a *new* view based on the selection. Figure \@ref(fig:shiny-drill-down) allows one to click on a category (e.g., Furniture) to generate another bar chart of sales broken down by that category's sub-categories (e.g., Bookcases, Chairs, etc.). From there, a sub-category may be clicked to populate a time series of sales for that sub-category. Finally, by clicking on the time series, a table of sales from that date are displayed.

Similar to Figure \@ref(fig:shiny-drill-down-bar-time-history), changes at a given category level cause invalidation of all child categories (in this case, all downstream views are cleared). For example, note how in Figure \@ref(fig:shiny-drill-down), a click of a category clears the sub-category and order-date. Moreover, a change in `sub_category` clears the `order_date`, but effect the current `category`.

\index{event\_data()@\texttt{event\_data()}!plotly\_click}

```{r eval = FALSE, summary = "Click to show/hide the code"}
library(shiny)
library(plotly)
library(dplyr)
library(readr)

sales <- read_csv("https://plotly-r.com/data-raw/sales.csv")

ui <- fluidPage(
  plotlyOutput("category", height = 200),
  plotlyOutput("sub_category", height = 200),
  plotlyOutput("sales", height = 300),
  dataTableOutput("datatable")
)

# avoid repeating this code
axis_titles <- . %>%
  layout(
    xaxis = list(title = ""),
    yaxis = list(title = "Sales")
  )

server <- function(input, output, session) {
  
  # for maintaining the state of drill-down variables
  category <- reactiveVal()
  sub_category <- reactiveVal()
  order_date <- reactiveVal()
  
  # when clicking on a category, 
  observeEvent(event_data("plotly_click", source = "category"), {
    category(event_data("plotly_click", source = "category")$x)
    sub_category(NULL)
    order_date(NULL)
  })
  
  observeEvent(event_data("plotly_click", source = "sub_category"), {
    sub_category(
      event_data("plotly_click", source = "sub_category")$x
    )
    order_date(NULL)
  })
  
  observeEvent(event_data("plotly_click", source = "order_date"), {
    order_date(event_data("plotly_click", source = "order_date")$x)
  })
  
  output$category <- renderPlotly({
    sales %>%
      count(category, wt = sales) %>%
      plot_ly(x = ~category, y = ~n, source = "category") %>%
      axis_titles() %>% 
      layout(title = "Sales by category")
  })
  
  output$sub_category <- renderPlotly({
    if (is.null(category())) return(NULL)
    
    sales %>%
      filter(category %in% category()) %>%
      count(sub_category, wt = sales) %>%
      plot_ly(x = ~sub_category, y = ~n, source = "sub_category") %>%
      axis_titles() %>%
      layout(title = category())
  })
  
  output$sales <- renderPlotly({
    if (is.null(sub_category())) return(NULL)
    
    sales %>%
      filter(sub_category %in% sub_category()) %>%
      count(order_date, wt = sales) %>%
      plot_ly(x = ~order_date, y = ~n, source = "order_date") %>%
      add_lines() %>%
      axis_titles() %>%
      layout(title = paste(sub_category(), "sales over time"))
  })
  
  output$datatable <- renderDataTable({
    if (is.null(order_date())) return(NULL)
    
    sales %>%
      filter(
        sub_category %in% sub_category(),
        as.Date(order_date) %in% as.Date(order_date())
      )
  })
  
}

shinyApp(ui, server)
```

```{r shiny-drill-down, echo=FALSE, fig.cap="(ref:shiny-drill-down)"}
include_vimeo("307597838")
```


### Cross-filter {#crossfilter}

Somewhat related to the drill-down idea is the so-called 'cross-filter' chart. The main difference between drill-down and cross-filter is that, with cross-filter, interactions don't generate new charts; interactions impose a filter on the data shown in a fixed set of multiple views. The typical cross-filter implementation allows for multiple brushes (i.e., filters) and uses the intersection of those filters to the dataset displayed in those views. Implementing a scalable and responsive cross-filter with three or more views can get quite complicated; we'll walk through some simple examples first for learning purposes, then progress to more sophisticated and complex applications.

Figure \@ref(fig:shiny-crossfilter-naive) demonstrates the simplest way to implement a cross-filter between *two* histograms. It uses the arrival (`arr_time`) and departure (`dep_time`) from the `flights` dataset via the **nycflights13** package [@nycflights13]. Notice how, in the implementation, the `dep_time` view is re-drawn from stratch every time the `arr_time` brush changes (and vice versa). Not only is it completely redrawn (i.e., it relies on `renderPlotly()` to perform the update), but it also uses `add_histogram()` which performs binning client-side (in the web browser). That means, every time a brush changes, the **shiny** server sends *all the raw data* to the browser and plotly.js redraws the histogram from scratch. 

```{r, eval = FALSE, summary = "Click to show code"}
library(shiny)
library(dplyr)
library(nycflights13)

ui <- fluidPage(
  plotlyOutput("arr_time"),
  plotlyOutput("dep_time")
)

server <- function(input, output, session) {
  
  output$arr_time <- renderPlotly({
    p <- plot_ly(flights, x = ~arr_time, source = "arr_time") 
    
    brush <- event_data("plotly_brushing", source = "dep_time")
    if (is.null(brush)) return(p)
    
    p %>%
      filter(between(dep_time, brush$x[1], brush$x[2])) %>%
      add_histogram()
  })
  
  output$dep_time <- renderPlotly({
    p <- plot_ly(flights, x = ~dep_time, source = "dep_time") 
    
    brush <- event_data("plotly_brushing", source = "arr_time")
    if (is.null(brush)) return(p)
    
    p %>%
      filter(between(arr_time, brush$x[1], brush$x[2])) %>%
      add_histogram()
  })
  
}

shinyApp(ui, server)
```

```{r shiny-crossfilter-naive, echo=FALSE, fig.cap="(ref:shiny-crossfilter-naive)"}
include_vimeo("318277110")
```

Although the video behind Figure \@ref(fig:shiny-crossfilter-naive) demonstrates the app is fairly responsive at 350,000 observations, this implementation won't scale to much larger data, especially if being viewed with a poor internet connection. I call this a 'naive' implementation because the reactive logic is easy to reason about, but it illustrates two common issues that we can address to gain speed improvements:

1. More data than necessary being sent 'over-the-wire' (i.e., between the server and the client). This idea is not unique to **shiny** applications; with any web application framework, it's important to minimize the amount of data your requesting from a server if you want a responsive website.
2. More client-side rendering work than necessary to achieve the request update.

The implementation behind Figure \@ref(fig:shiny-crossfilter-naive) could improve in these areas by doing the following:

1. Perform the binning server-side instead of client-side. This will reduce the amount of data needed to be sent from server to client so that responsiveness is less dependent on a good internet connection. Here we propose using **ggstat** for the server-side binning since it's fairly fast and simple if you're data can fit into memory [@ggstat]. If your data does not fit into memory you could use something like **dbplot** to perform the binning in a database [@dbplot].
2. Perform less rendering work client-side. That is, instead of relying on `renderPlotly()` to re-render the chart from scratch every time the charts need an update, we could instead modify just the bar heights (using the techniques from Section \@ref(proxies)).

```{r, eval = FALSE, summary = "Click to below to see the responsive implementation"}
library(shiny)
library(dplyr)
library(nycflights13)
library(ggstat)

arr_time <- flights$arr_time
dep_time <- flights$dep_time
arr_bins <- bin_fixed(arr_time, bins = 250)
dep_bins <- bin_fixed(dep_time, bins = 250)
arr_stats <- compute_stat(arr_bins, arr_time) %>%
  filter(!is.na(xmin_))
dep_stats <- compute_stat(dep_bins, dep_time) %>%
  filter(!is.na(xmin_))

ui <- fluidPage(
  plotlyOutput("arr_time", height = 250),
  plotlyOutput("dep_time", height = 250)
)

server <- function(input, output, session) {
  
  output$arr_time <- renderPlotly({
    plot_ly(arr_stats, source = "arr_time") %>%
      add_bars(x = ~xmin_, y = ~count_) 
  })
  
  output$dep_time <- renderPlotly({
    plot_ly(dep_stats, source = "dep_time") %>%
      add_bars(x = ~xmin_, y = ~count_) 
  })
  
  # arr_time brush updates dep_time view
  observe({
    brush <- event_data("plotly_brushing", source = "arr_time")
    p <- plotlyProxy("dep_time", session)
    
    # if brush is empty, restore default
    if (is.null(brush)) {
      plotlyProxyInvoke(p, "restyle", "y", list(dep_stats$count_), 0)
    } else {
      in_filter <- between(dep_time, brush$x[1], brush$x[2])
      dep_count <- dep_bins %>%
        compute_stat(dep_time[in_filter]) %>%
        filter(!is.na(xmin_)) %>%
        pull(count_)
      
      plotlyProxyInvoke(p, "restyle", "y", list(dep_count), 0)
    }
  })
  
  observe({
    brush <- event_data("plotly_brushing", source = "dep_time")
    p <- plotlyProxy("arr_time", session)
    
    # if brush is empty, restore default
    if (is.null(brush)) {
      plotlyProxyInvoke(p, "restyle", "y", list(arr_stats$count_), 0)
    } else {
      in_filter <- between(arr_time, brush$x[1], brush$x[2])
      arr_count <- arr_bins %>%
        compute_stat(arr_time[in_filter]) %>%
        filter(!is.na(xmin_)) %>%
        pull(count_)
      
      plotlyProxyInvoke(p, "restyle", "y", list(arr_count), 0)
    }
  })
  
}

shinyApp(ui, server)
```

Before we address the additional complexity that comes with linking three or more views, let's consider targeting a 2D distribution in the cross-filter, as in Figure \@ref(fig:shiny-crossfilter-kde). This approach uses `kde2d()` from the **MASS** package to summarize the 2D distribution server-side rather than attempting to show all the raw data in a scatterplot.^[It's possible to do this responsively with about 50,000 observations, but it won't scale to anything much larger than that. Run `plotly_example("shiny", "crossfilter_scatter")` to see it in action as well as a corresponding video at <https://vimeo.com/318129005>] 
```r
plotly_example("shiny", "crossfilter_kde")
```

```{r shiny-crossfilter-kde, echo=FALSE, fig.cap="(ref:shiny-crossfilter-kde)"}
include_vimeo("318122403")
```

When linking three or more views in a cross-filter, it's important to have a mechanism to maintain the state of all the active brushes. This is because, when updating a given view, it needs to know about *all* of the  active brushes. The implementation behind Figure \@ref(fig:shiny-crossfilter) maintains the range of every active brush through a `reactiveValues()` variable named `brush_ranges`. Every time a brush changes, the state of `brush_ranges` is updated, then it is used to filter the data down to the relevant observations. That filtered data is then binned and used to modify the bar heights of every view (except for the one being brushed).

```r
plotly_example("shiny", "crossfilter")
```

```{r shiny-crossfilter, echo=FALSE, fig.cap="(ref:shiny-crossfilter)"}
include_vimeo("318129502")
```

One weakness of a typical cross-filter interface like Figure \@ref(fig:shiny-crossfilter) is that it's difficult to make visual comparisons. That is, when a filter is applied, you lose a visual reference to the overall distribution and/or prior filter, making it difficult to make meaningful comparisons. Figure \@ref(fig:shiny-crossfilter) modifies the logic of Figure \@ref(fig:shiny-crossfilter-compare) to enable filter comparisons by adding the ability to change the color of the brush. Moreover, for the sake of demonstration and simplicity, it also allows for only one active filter per color (i.e., brushing within color is transient). One could borrow logic from Figure \@ref(fig:shiny-crossfilter) to allow multiple filters for each color, but this would require multiple `brush_ranges`.

Since brushing within color is transient, in contrast to Figure \@ref(fig:shiny-crossfilter), Figure \@ref(fig:shiny-crossfilter-compare) doesn't have to track the state of all the active brushes. It does, however, need to display *relative* rather than absolute frequencies to facilitate comparison of small filter range(s) to the overall distribution. This particular implementation takes the overall distribution as a "base layer" that remains fixed and overlays a handful of "selection layers", one for each possible brush color. These selection layers all begin with a height of 0. When a brush event occurs, only the bar height of the appropriate layer is updated. This approach may feel like a hack, but it leads to a fluid user experience because it's not much work to adjust the height of a bar that already exists. 

```r
plotly_example("shiny", "crossfilter_compare")
```

```{r shiny-crossfilter-compare, echo=FALSE, fig.cap="(ref:shiny-crossfilter-compare)"}
include_vimeo("327622610")
```

### A draggable brush {#drag-brush}

\index{Editable charts!Rectangles}

A *draggable* linked brush is great for conditioning via a moving window. For example, in a cross-filtering example like Figure \@ref(fig:shiny-crossfilter), it would be nice to condition on a certain hour of day, then drag that hour interval along the axis to explore how the hourly distribution changes throughout the day. At the time of writing, plotly.js does not support a draggable brush, but we could implement one with a clever use of an editable rectangle shape. Figure \@ref(fig:shiny-drag-brush) demonstrates this idea in a **shiny** application by drawing a rectangle shape that mimics the plotly.js brush, then uses the `"plotly_relayout"` event to determine the limits of the brush (instead of the `"plotly_brushed"` or `"plotly_brushing"`).

```r
plotly_example("shiny", "drag_brush")
```

```{r shiny-drag-brush, echo=FALSE, fig.cap="(ref:shiny-drag-brush)"}
include_vimeo("318330112")
```


## Discussion

Compared to the linking framework covered in Section \@ref(graphical-queries), the ability to link views server-side with **shiny** opens the door to many new possibilities. This chapter focuses mostly on using just **plotly** within **shiny**, but the **shiny** ecosystem is vast and these techniques can of course be used to inform other views, such as static plots, other **htmlwidgets** packages (e.g., **leaflet**, **DT**, **network3D**, etc.), and other custom **shiny** bindings. In fact, I have numerous **shiny** apps publicly available via an R package that use numerous tools to provide exploratory interfaces to a variety of domain-specific problems, including `zikar::explore()` for exploring Zika virus reports, `eechidna::launch()` for exploring Australian election and census data, and `bcviz::launch()` for exploring housing and census information in British Colombia [@bcviz; @zikar; @eechidna]. These complex applications also serve as a reference as to how one can use the client-side linking framework (i.e., **crosstalk**) inside a larger **shiny** application. See this video for an example:

```{r shiny-crosstalk-examples, echo=FALSE, fig.cap="(ref:shiny-crosstalk-examples)"}
include_vimeo("207379729")
```

Sometimes **shiny** gets a bad rap for being too slow or unresponsive, but as we learned in Sections \@ref(proxies) and \@ref(advanced-applications), we can still have very advanced functionality as well as a good user experience; it just takes a bit more effort to optimize performance in some cases. In fact, one could argue that a server-client approach to cross-filtering, as done in Figure \@ref(fig:shiny-crossfilter) is more scalable than a purely client-side approach since the client wouldn't need to know about the raw data, just the summary statistics. Nevertheless, sometimes linking views server-side simply isn't an option for you or your organization.

Maybe your IT administrator simply won't allow you to distribute your work outside of a standalone HTML file. Figure \@ref(fig:shiny-corrplot) is just one example of a linked graphic that *could* be replicated using the graphical querying framework from Section \@ref(graphical-queries), but it would require pre-computing every possible view (which becomes un-manageable when there are many possible selections) and posing the update logic as a database query. When users are only allowed to select (e.g., click/hover) a single element at a time, the number of possible selections increases linearly with the number of elements, but when users are allowed to select any subset of elements (e.g., scatterplot brushing), the number of possible selections explodes (increases at a factorial rate). For example, adding a cell to Figure \@ref(fig:shiny-corrplot) only adds one possible selection, but if we added more states to Figure \@ref(fig:shiny-corrplot), the number of possible states goes from 50! to 51!.

Even in the case that you need a standalone HTML file and the R API that **plotly** provides doesn't support the type of interactivity that you desire, you can always layer on additional JavaScript to hopefully achieve the functionality you desire. This can be useful for something as simple as opening a hyperlink when clicking on marker of a plotly graph. This topic is covered in Chapter \@ref(javascript).