Read plot values interactively (with a targetting line) in a Shiny app - r

Question

I'm essentially trying to replicate the behavior of the graph on this site in a Shiny app.
That is, I want to create an interactive graph, where by hovering the mouse cursor over the graph, you move a "targeting line" along the x-axis. Then, according to the position of the targeting line, the y-values of the plot lines on the graph are displayed on the intersection point of the targeting line and the plot lines. (I was going to post an illustrative figure, but it appears I don't have enough reputation for that yet.)
I've managed to get the application to work. In my current implementation I'm using the hover option in plotOutput to get the location of the cursor on the plot, and then adding a targeting line using abline to a new plot. Along with points and text to add the y-values on the plot.
The issue I'm having is that the targeting line starts to severely lag behind the actual mouse cursor after moving around for a while. I think this is due to having to redraw the entire plot every time the mouse hovering position updates (currently every 500 ms when the cursor is moving, since I'm using hoverOpts(delayType = "throttle")). The rendering just isn't fast enough to keep up with the mouse movement. I was wondering if anybody has an idea on how to get around this problem.
Runnable code for an example of the Shiny app:
library(shiny)
trigWaves <- function(A = 1, ...) {
xval <- seq(0, 2*pi, len = 201)
sinx <- A * sin(xval); cosx <- A * cos(xval)
plot(x = xval, y = sinx, type = 'n', ylab = "f(x)", xlab = "x", ...)
abline(h = A * c(-1, 0, 1), lty = c(2, 1, 2), col = 'gray')
abline(v = pi * seq(0, 2, by = 0.5), lty = 2, col = 'gray')
lines(x = xval, y = sinx, col = 'red')
lines(x = xval, y = cosx, col = 'blue')
box()
invisible(list(x = xval, y = list(sin = sinx, cos = cosx)))
}
# Maximum selectable amplitude
Amax <- 5
runApp(
# Define UI for application
list(ui = pageWithSidebar(
# Application title
headerPanel("Read Function Values Interactively from a Plot"),
sidebarPanel(
sliderInput("amplitude",
"Amplitude:",
min = 1,
max = Amax,
value = 2,
step = 0.1)
),
mainPanel(
plotOutput("trigGraph",
hover =
hoverOpts(
id = "plothover",
delay = 500,
delayType = "throttle"
)
)
)
),
# Define server for application
server = function(input, output, session) {
A <- reactive(input$amplitude)
hoverx <- reactiveValues(initial = 2)
# Hover position
tx <- reactive({
# If no previous hover position found, return initial = 0
if (is.null(hoverx$prev)) return(hoverx$initial)
# Hover resets to NULL every time the plot is redrawn -
# If hover is null, then use the previously saved hover value.
if (is.null(input$plothover)) hoverx$prev else input$plothover$x
})
# Function to plot the 'reader line' and the function values
readLine <- reactive({
abline(v = tx(), col = 'gray'); box()
# Plot coordinates for values and points
pcoords <- list(x = rep(tx(), 2), y = A() * c(sin(tx()), cos(tx())))
points(pcoords, pch = 16, col = c("red", "blue")) # points on lines
text(pcoords, labels = round(pcoords$y, 2), pos = 4) # function values
})
# Render the final output graph
output$trigGraph <- renderPlot({
# Create base plot
trigWaves(A = A(), ylim = Amax * c(-1, 1))
readLine() # Add the reader line and function values
# Add a legend
legend(x = 3.5, y = 0.9 * Amax,
legend = c("sin(x)", "cos(x)"),
col = c("red", "blue"), lty = 1)
# Save the hover position used as the previous position
hoverx$prev <- tx()
})
}), display.mode= "showcase"
)

Answer 1

Six years later, JavaScript is still the way to go for a graph like this.
Here’s an overview of a couple of different R packages to achieve that,
including dygraphs and highcharts originally mentioned in the comments.
# Goal is to make an interactive crosshair plot with data from this.
trigWaves <- function(x, A = 1, ...) {
rbind(
data.frame(x, y = A * sin(x), f = "sin"),
data.frame(x, y = A * cos(x), f = "cos")
)
}
xs <- seq(0, 2 * pi, len = 201)
Amax <- 5 # Maximum amplitude -- determines plot range, too.
Plotting methods
dygraphs
library(dygraphs)
plot_dygraphs = function(data) {
# Unlike other packages, dygraphs wants wide data
wide <- data %>%
tidyr::pivot_wider(
names_from = f,
values_from = y
)
dygraph(wide) %>%
dyCrosshair("vertical") %>%
dyAxis("y", valueRange = c(-1, 1) * Amax)
}
highcharter
library(highcharter)
plot_highcharter = function(data) {
hchart(data, "line", hcaes(x, y, group = f)) %>%
hc_xAxis(crosshair = TRUE) %>%
hc_yAxis(min = -Amax, max = Amax)
}
plotly
library(plotly)
plot_plotly = function(data) {
plot_ly(data) %>%
add_lines(~ x, ~ y, color = ~ f) %>%
layout(
hovermode = "x",
spikedistance = -1,
xaxis = list(
showspikes = TRUE,
spikemode = "across"
),
yaxis = list(range = c(-1, 1) * Amax)
)
}
c3
library(c3)
plot_c3 = function(data) {
c3(data, "x", "y", group = "f") %>%
c3_line("line") %>%
yAxis(min = -Amax, max = Amax) %>%
point_options(show = FALSE)
}
Shiny app
All of the packages also integrate with Shiny. Here’s a demo app showcasing them:
library(shiny)
ui <- fluidPage(
sliderInput("amplitude", "Amplitude:", 0.1, Amax, 1, step = 0.1),
fluidRow(
column(6,
tags$h3("dygraphs"),
dygraphOutput("dygraphs"),
),
column(6,
tags$h3("highcharter"),
highchartOutput("highcharter"),
),
column(6,
tags$h3("plotly"),
plotlyOutput("plotly"),
),
column(6,
tags$h3("c3"),
c3Output("c3", height = "400px"), # All others have 400px default height
)
)
)
server <- function(input, output, session) {
waves <- reactive(trigWaves(xs, input$amplitude))
output$dygraphs <- renderDygraph({ plot_dygraphs(waves()) })
output$highcharter <- renderHighchart({ plot_highcharter(waves()) })
output$plotly <- renderPlotly({ plot_plotly(waves()) })
output$c3 <- renderC3({ plot_c3(waves()) })
}
shinyApp(ui, server)
See it live here: https://mikkmart.shinyapps.io/crosshair/