在 Shiny 应用程序中以交互方式（使用目标线）读取绘图值

Question

我实际上是在尝试在 Shiny 应用程序中复制 this 网站上的图形行为。

也就是说，我想创建一个交互式图形，通过将鼠标光标悬停在图形上，您可以沿 x 轴移动 "targeting line"。然后根据目标线的位置，在目标线和绘图线的交点处显示图形上绘图线的y值。（我打算 post 一个说明性的数字，但似乎我还没有足够的声誉。）

我已经设法让应用程序正常工作。在我当前的实现中，我使用 plotOutput 中的 hover 选项来获取光标在图上的位置，然后使用 abline 添加目标线到新图。与 points 和 text 一起在图上添加 y 值。

我遇到的问题是，在移动了一段时间后，瞄准线开始严重滞后于实际的鼠标光标。我认为这是由于每次鼠标悬停位置更新时都必须重新绘制整个图（目前光标移动时每 500 毫秒，因为我使用的是 hoverOpts(delayType = "throttle")）。渲染速度不够快，跟不上鼠标的移动。我想知道是否有人知道如何解决这个问题。

Shiny 应用示例的可运行代码：

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

六年过去了，JavaScript 仍然是制作这样的图表的方法。

这里概述了几个不同的 R 包来实现这一点，包括评论中最初提到的 dygraphs 和 highcharts。

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

绘图方法

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 集成。这是展示它们的演示应用程序：

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)

现场观看：https://mikkmart.shinyapps.io/crosshair/

在 Shiny 应用程序中以交互方式（使用目标线）读取绘图值

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

绘图方法

闪亮的应用程序