Shiny reactive value directly in onRender() function of htmlWidgets

htmlwidgets, onrender, plotly, r, shiny

Solution

You can use define a custom message handler in your `onRender` function and use it in `server.R` to pass the selected point coordinates.

The `onRender` function of the second plot could look like:

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);
  });
}

And in your `server.R` you could do:

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

Whenever a point is selected, the coordinates will be sent to the function defined in the `onRender` and the point will be drawn.

Problem

I have a Shiny application that has two plots. If a user clicks on a point in the top plot, the x and y coordinate of that point are saved to a reactive Shiny variable (in the code below, it is called pointSel). In the bottom plot, I would like the x and y coordinate from this pointSel to be plotted as a green point. I have this working currently (as seen in the script below). However, each time the pointSel object is updated, the second plot is plotted all over again. Instead, I am trying to keep the second plot background unplotted and to simply overlay a new green point on top of it. I believe this would require two things: 1) The isolate() function applied to "data = pointSel()" in the onRender() function. 2) Some syntax that alerts to only add the green dot trace if the pointSel has been updated. I put tentative syntax for this in comments "$('#pointSel').on('click',function()". Below is my code: ``` 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) ``` Note: This is a similar problem to what I posted earlier and has a helpful answer (Shiny actionButton() output in onRender() function of htmlWidgets). I have been coming across variants of this problem (being unable to overlay aspects of a plot to a background plot in the onRender() function), and this current post is simply another variant of that problem. I am trying to find a similar answer for this situation! Thank you for any advice.

Original source