Question

我正在使用plotly和Shiny，并且在一页上有两个图。两个图中的点具有相同的标签。现在，当在图2上悬停具有相同标签的点时，我想强制将悬停标签显示在图1上。

我尝试使用可打印的postMessage API（改编自https://github.com/plotly/postMessage-API#hover）来执行此操作，但未成功。我作为MWE的尝试如下。感谢您的帮助。

library(shiny)
library(shinycssloaders)
library(shinydashboard)
library(shinyjs)
library(V8)
library(plotly)

# this is the hover javascript
hoverJSPlot2 <- "
  shinyjs.hoverPlot2 = function(params) {

    var defaultParams = {
      x : null,
      y : null
    };

    params = shinyjs.getParams(params, defaultParams);

    var plot = document.getElementById('plot1').contentWindow;

    plot.postMessage({
      'task': 'hover',
      'selection': {xval: params.x, yval: params.y},
    }, 'https://plot.ly');

  }
"

ui <- fluidPage(

  # make a bos and add a row to it.
  box(
    width = 12,

    # Row for the graphs
    fluidRow(

      # Add the first graph
      column(
        6,
        useShinyjs(),
        extendShinyjs(text = hoverJSPlot2),
        plotlyOutput("plot1")
      ),

      column(
        6,
        plotlyOutput("plot2")
      )
    )
  )
)

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

  plotData1 <- reactive({
    # generate random data
    data.frame(x = rnorm(100, mean = 10, sd = 5),
               y = rnorm(100, mean = 5, sd = 5),
               label = paste0("Label - ", c(1:100)))
  })

  plotData2 <- reactive({
    # generate random data
    data.frame(x = rnorm(100, mean = 10, sd = 5),
               y = rnorm(100, mean = 5, sd = 5),
               label = paste0("Label - ", c(1:100)))
  })

  output$plot1 <- renderPlotly({

    req(plotData1())

    plotData1 <- plotData1()

    plot_ly(
      data = plotData1,
      type = "scattergl",
      x = ~ x,
      y = ~ y,
      key = plotData1$label,
      hoverinfo = "text",
      text = plotData1$label,
      source = "plot1",
      mode = "markers",
      marker = list(size  =4, opacity = 0.8)
    )
  })

  output$plot2 <- renderPlotly({

    req(plotData2())

    plotData2 <- plotData2()

    plot_ly(
      data = plotData2,
      type = "scattergl",
      x = ~ x,
      y = ~ y,
      key = plotData2$label,
      hoverinfo = "text",
      text = plotData2$label,
      source = "plot2",
      mode = "markers",
      marker = list(size  =4, opacity = 0.8)
    )
  })

  # begin the hover story
  hoveredPointPlot2 <- reactive({
    event_data("plotly_hover", source = "plot2")
  })

  observeEvent(hoveredPointPlot2(), {
    req(hoveredPointPlot2())

    # below doesn't work....

    hoveredPoint <- hoveredPointPlot2()
    hoveredLabel <- hoveredPoint$key

    # get the adult data
    plotData1 <- plotData1()

    plotData1 <- plotData1[plotData1$label == hoveredLabel,]

    if (nrow(plotData1) != 0) {
      js$hoverPlot2(plotData1$x, plotData1$y)
    }

  })

}

shinyApp(ui = ui, server = server)

Answer 1

我正在尝试类似的操作，但是基于我自己的答案并查看您提供的链接，我认为使用postMessage API是不可能的。 postMessage文档状态：

如果要使用该API，第一步是创建一个Plotly图或使用其他人的图，然后将其作为iframe嵌入Codepen或网页中。

表示该方法仅与iframe元素兼容。

如果在浏览器中运行Shiny App并检查页面，则会发现JS代码document.getElementById('plot1').contentWindow;不起作用，因为不存在名为plot1的iframe元素。据我所知，这是不可能的，而且似乎不可能将用renderPlotly()创建的元素转换为iframe。

强制情节悬停标签

1 个答案: