Interactive plots

Click, brush, and reactiveValues()

A plot can also be used as an input. Try it: choose a dataset, click Load data, then Select & Display, and finally click on a point or draw a rectangle on the plot.

#| '!! shinylive warning !!': |
#|   shinylive does not work in self-contained HTML documents.
#|   Please set `embed-resources: false` in your metadata.
#| standalone: true
#| components: [viewer]
#| viewerHeight: 750
## file: ui.R
library(shiny)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("dataset", "Choose a dataset:",
                  choices = c("rock", "pressure", "cars")),
      actionButton("load", "Load data"),
      conditionalPanel(
        condition = "input.load >= 1",       # shown after the first click
        uiOutput("var1"),
        uiOutput("var2"),
        actionButton("select", "Select & Display")
      )
    ),
    mainPanel(
      plotOutput(
        "graph",
        click = clickOpts(id = "plot_click"),  # click -> input$plot_click
        brush = brushOpts(id = "plot_brush")   # drag  -> input$plot_brush
      ),
      fluidRow(
        column(4, verbatimTextOutput("summary")),
        column(4, verbatimTextOutput("points")),
        column(4, verbatimTextOutput("brush"))
      )
    )
  )
)

## file: server.R
library(shiny)

server <- function(input, output, session) {

  # reactiveValues: a "shelf" where we put objects and change them later
  values <- reactiveValues()

  observeEvent(input$load, {
    values$data <- switch(input$dataset,
                          rock = rock,
                          pressure = pressure,
                          cars = cars)
  })

  output$var1 <- renderUI({
    nam <- names(values$data)
    selectInput("var1", "Select x:", choices = nam, selected = nam[1])
  })

  output$var2 <- renderUI({
    nam <- names(values$data)
    selectInput("var2", "Select y:", choices = nam, selected = nam[2])
  })

  observeEvent(input$select, {
    values$df <- values$data[, c(input$var1, input$var2)]
  })

  output$graph <- renderPlot({
    validate(need(input$select > 0, "Waiting for data"))
    plot(values$df[, 1:2])
  })

  output$summary <- renderPrint({
    validate(need(input$select > 0, "Waiting for data"))
    summary(values$df)
  })

  output$points <- renderPrint({
    req(values$df)
    pointID <- nearPoints(values$df, input$plot_click,
                          xvar = names(values$df)[1],
                          yvar = names(values$df)[2])
    validate(need(nrow(pointID) != 0, "Click on a point"))
    pointID
  })

  output$brush <- renderPrint({
    req(values$df)
    brushID <- brushedPoints(values$df, input$plot_brush,
                             xvar = names(values$df)[1],
                             yvar = names(values$df)[2])
    validate(need(nrow(brushID) != 0, "Highlight an area"))
    brushID
  })
}

How it works

A plotOutput() can also be an input: if you give it the click and brush arguments, the coordinates of a click, or of the rectangle drawn with the mouse, arrive in the server as input$plot_click and input$plot_brush.

plotOutput("graph",
1           click = clickOpts(id = "plot_click"),
2           brush = brushOpts(id = "plot_brush"))

1

A click on the plot → input$plot_click

2

A rectangle drawn on the plot → input$plot_brush

Two helpers turn the coordinates into rows of the data:

nearPoints(df, input$plot_click, xvar = "speed", yvar = "dist")      # rows close to the click
brushedPoints(df, input$plot_brush, xvar = "speed", yvar = "dist")   # rows inside the rectangle

The code

#| '!! shinylive warning !!': |
#|   shinylive does not work in self-contained HTML documents.
#|   Please set `embed-resources: false` in your metadata.
#| standalone: true
#| components: [editor, viewer]
#| layout: vertical
#| viewerHeight: 750
## file: ui.R
library(shiny)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("dataset", "Choose a dataset:",
                  choices = c("rock", "pressure", "cars")),
      actionButton("load", "Load data"),
      conditionalPanel(
        condition = "input.load >= 1",       # shown after the first click
        uiOutput("var1"),
        uiOutput("var2"),
        actionButton("select", "Select & Display")
      )
    ),
    mainPanel(
      plotOutput(
        "graph",
        click = clickOpts(id = "plot_click"),  # click -> input$plot_click
        brush = brushOpts(id = "plot_brush")   # drag  -> input$plot_brush
      ),
      fluidRow(
        column(4, verbatimTextOutput("summary")),
        column(4, verbatimTextOutput("points")),
        column(4, verbatimTextOutput("brush"))
      )
    )
  )
)

## file: server.R
library(shiny)

server <- function(input, output, session) {

  # reactiveValues: a "shelf" where we put objects and change them later
  values <- reactiveValues()

  observeEvent(input$load, {
    values$data <- switch(input$dataset,
                          rock = rock,
                          pressure = pressure,
                          cars = cars)
  })

  output$var1 <- renderUI({
    nam <- names(values$data)
    selectInput("var1", "Select x:", choices = nam, selected = nam[1])
  })

  output$var2 <- renderUI({
    nam <- names(values$data)
    selectInput("var2", "Select y:", choices = nam, selected = nam[2])
  })

  observeEvent(input$select, {
    values$df <- values$data[, c(input$var1, input$var2)]
  })

  output$graph <- renderPlot({
    validate(need(input$select > 0, "Waiting for data"))
    plot(values$df[, 1:2])
  })

  output$summary <- renderPrint({
    validate(need(input$select > 0, "Waiting for data"))
    summary(values$df)
  })

  output$points <- renderPrint({
    req(values$df)
    pointID <- nearPoints(values$df, input$plot_click,
                          xvar = names(values$df)[1],
                          yvar = names(values$df)[2])
    validate(need(nrow(pointID) != 0, "Click on a point"))
    pointID
  })

  output$brush <- renderPrint({
    req(values$df)
    brushID <- brushedPoints(values$df, input$plot_brush,
                             xvar = names(values$df)[1],
                             yvar = names(values$df)[2])
    validate(need(nrow(brushID) != 0, "Highlight an area"))
    brushID
  })
}

What else is in this app

• reactiveValues(): a “shelf” (values$data, values$df) where observeEvent() puts objects, and the outputs take them. It is an alternative to eventReactive(): more flexible, but the flow is harder to follow
• conditionalPanel(condition = "input.load >= 1", ...): the variable menus appear only after the first click on Load data
• validate(need(condition, "message")): like req(), but it shows a message to the user instead of an empty box