Блестящее реактивное значение прямо в функции onRender() htmlWidgets

Question

У меня есть блестящее приложение, которое имеет два сюжета. Если пользователь щелкает точку на верхнем графике, координаты x и y этой точки сохраняются в реактивной переменной Shiny (в приведенном ниже коде она называется pointSel).

На нижнем графике я бы хотел, чтобы координаты x и y этой точки отображались как зеленая точка. У меня это работает в настоящее время (как видно из сценария ниже). Однако каждый раз, когда объект pointSel обновляется, второй график строится заново. Вместо этого я пытаюсь не задавать фон второго графика и просто наложить на него новую зеленую точку.

Я считаю, что это потребует двух вещей:

1) Функция isolate (), примененная к "data = pointSel()" в функции onRender().

2) Некоторый синтаксис, который предупреждает о добавлении трассировки зеленой точки, только если pointSel был обновлен. Я поставил предварительный синтаксис для этого в комментариях "$('#pointSel'). On('click',function()".

Ниже мой код:

library(plotly)
library(GGally)
library(hexbin)
library(htmlwidgets)
library(tidyr)
library(shiny)
library(edgeR)
library(EDASeq)
library(dplyr)
library(data.table)
library(ggplot2)

ui <- shinyUI(fluidPage(
  plotlyOutput("plot1"),
  plotlyOutput("plot2")
))

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

  data <- data.frame(mpg=mtcars$mpg,qsec=mtcars$qsec)

  output$plot1 <- renderPlotly({

    p <- qplot(data$mpg,data$qsec)
    pP <- ggplotly(p)

    pP %>% onRender("
      function(el, x, data) {

      el.on('plotly_click', function(e) {
        var pointSel = [e.points[0].x, e.points[0].y]
        Shiny.onInputChange('pointSel', pointSel);
      })}

      ", data = data)
  })

  pointSel <- reactive(input$pointSel)

  output$plot2 <- renderPlotly({

    p2 <- qplot(mpg,qsec,data=data, geom="point", alpha=I(0))
    pP2 <- ggplotly(p2)

    pP2 %>% onRender("
      function(el, x, data) {
        console.log('Whole bottom plot is being redrawn')
        var myX = data[0]
        var myY = data[1]
      //$('#pointSel').on('click',function() {
        var Traces = [];
        var trace = {
          x: [myX],
          y: [myY],
          mode: 'markers',
          marker: {
            color: 'green',
            size: 10
          }
        };
        Traces.push(trace);
        Plotly.addTraces(el.id, Traces);
      //})
    }", data = pointSel())
  })
})

shinyApp(ui, server)

Примечание. Эта проблема аналогична той, которую я опубликовал ранее, и дает полезный ответ ( Shiny actionButton () выводится в функции onRender() htmlWidgets). Я сталкивался с вариантами этой проблемы (будучи неспособным наложить аспекты графика на фоновый график в функции onRender()), и этот текущий пост - просто еще один вариант этой проблемы. Я пытаюсь найти аналогичный ответ для этой ситуации! Спасибо за любой совет.

Answer 1

Вы можете использовать определить собственный обработчик сообщений в вашем onRender функционировать и использовать его в server.R передать координаты выбранной точки.

onRender Функция второго сюжета может выглядеть так:

function(el, x, data) {
  Shiny.addCustomMessageHandler('draw_point',
  function(point) {
    var Traces = [];
    var trace = {
      x: [point[0]],
      y: [point[1]],
      mode: 'markers',
      marker: {
        color: 'green',
        size: 10
      }
    };
    Traces.push(trace);
    console.log(Traces);
    Plotly.addTraces(el.id, Traces);
  });
}

И в твоем server.R Вы могли бы сделать:

  observe({
    session$sendCustomMessage(type = "draw_point", input$pointSel)
  })

Всякий раз, когда точка выбрана, координаты будут отправлены функции, определенной в onRender и точка будет нарисована.