javascript - Change a single point in a plotly scatter3d in R shiny

Question

I have an app where I am trying to change a point's size or color or symbol. The point being the object that the user has clicked. Clicking a point creates a popup in my program that shows another dataset linked to the ID value in a column belonging to the rownumber belonging to the point clicked. I included the flow of events in the demo app (without popups) for the click event.

I'm trying to change the point based on the answer here for a plotly 2d scatter plot. However, applying the code to my 3d plot doesn't seem to work.

A little extra background info: i'm building a program to analyse 3d scatter data and my app contains several of these 3D plots

Does anyone know how to make this work?

The app below contains the code for both a 2d (commented) and 3d plot object to show the working and non working situation and is a direct modification of the code given by @Maximilian Peters

Thank you for any help!

bonus question: Assuming we can make it work for the 3dplot, I would also like to figure out how to change the JavaScript code to change a point based on a number stored in a reactive variable (i.e. values$activepoint) rather than from a click event since I will allow the user to cycle through points with a <- and -> button that changes the point ID we are retrieving the additional info from.

library(shiny)
library(plotly)
library(htmlwidgets)

ui <- fluidPage(
  plotlyOutput("plot"),
  textOutput('messageNr')
)

javascript <- "
function(el, x){
el.on('plotly_click', function(data) {
colors = [];
var base_color = document.getElementsByClassName('legendpoints')[data.points[0].curveNumber].getElementsByTagName('path')[0].style['stroke']
for (var i = 0; i < data.points[0].data.x.length; i += 1) {
colors.push(base_color)
};
colors[data.points[0].pointNumber] = '#000000';
Plotly.restyle(el, 
{'marker':{color: colors}}, 
[data.points[0].curveNumber]
);
//make sure all the other traces get back their original color
for (i = 0; i < document.getElementsByClassName('plotly')[0].data.length; i += 1) {
if (i != data.points[0].curveNumber) {
colors = [];
base_color = document.getElementsByClassName('legendpoints')[i].getElementsByTagName('path')[0].style['stroke'];
for (var p = 0; p < document.getElementsByClassName('plotly')[0].data[i].x.length; p += 1) {
colors.push(base_color);
}
Plotly.restyle(el, 
{'marker':{color: colors}}, 
[i]);
}
};
});
}"


server <- function(input, output, session) {
  row.names(mtcars) <- 1:nrow(mtcars)
  colorscale <- c("blue", "red", "yellow")

  values <- reactiveValues()

  output$plot <- renderPlotly({
    values$point <- event_data("plotly_click", source = "select")

  plot_ly(mtcars,
          x = ~mpg,
          y = ~cyl,
          z = ~wt,
          type = "scatter3d",
          color = as.factor(mtcars$gear),
          colors = colorscale,
          mode = "markers",
          source = "select",
          showlegend = F)%>%
    add_markers() %>% onRender(javascript)
  } )



observeEvent(values$point, {
  values$row <- as.numeric(values$point$pointNumber) +1
   values$ID <- rownames(mtcars)[values$row]
   ### the values$ID is what I use to look up the corresponding dataset in other dataframes containing the detailed info of a datapoint in the 
   ### summary data set that is used to create the real scatter3d plots in which the user clicks. 
  output$messageNr <- renderText(values$ID)
  })
 }

# server <- function(input, output, session) {
# 
#   nms <- row.names(mtcars)
# 
#   output$plot <- renderPlotly({
#     p <- ggplot(mtcars, aes(x = mpg, y = wt, col = as.factor(cyl))) +
#       geom_point()
#     ggplotly(p) %>% onRender(javascript)
# 
#   })
# }

shinyApp(ui, server)

Answer 1

You could add a trace just for highlighting the point, change the location of the single point in response to a Javascript eventListener.

library(shiny)
library(plotly)
library(htmlwidgets)

ui <- fluidPage(
  plotlyOutput("plot"),
  textOutput('messageNr')
)

javascript <- "
function(el, x) {
  el.on('plotly_click', function(data) {

    var highlight_trace = el.data.length - 1;
    //the coordinates of the point which was clicked on
    //is found in data
    var newPoint = {x: data.points[0].x,
                    y: data.points[0].y,
                    z: data.points[0].z};

    //update the plot data and redraw it
    if (el.data[highlight_trace].x[0] != newPoint.x ||
        el.data[highlight_trace].y[0] != newPoint.y ||
        el.data[highlight_trace].z[0] != newPoint.z) {
      el.data[highlight_trace].x[0] = newPoint.x;
      el.data[highlight_trace].y[0] = newPoint.y      
      el.data[highlight_trace].z[0] = newPoint.z
      Plotly.redraw(el);
      }
  })
}
"


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

  output$plot <- renderPlotly(
    {
      p <- plot_ly()
      p <- add_trace(p,
              data = mtcars,
              x = ~mpg,
              y = ~cyl,
              z = ~wt,
              color = as.factor(mtcars$gear),
              type = 'scatter3d',
              mode = "markers")
      p <- add_trace(p, 
                     x = c(20), 
                     y = c(5), 
                     z = c(4), 
                     name = 'highlight',
                     type = 'scatter3d',
                     mode = 'markers',
                     marker = list(size = 15,
                                   opacity = 0.5)) %>% onRender(javascript)
      p
    } 
  )
}

shinyApp(ui, server)

• el is the JavaScript element where your plot is stored
• 'el.data' is where Plotly stores the data for your plot
• the if block makes sure that the graph is only redrawn if a new point is clicked on
• if a point is clicked on, the data for the highlight trace is overwritten and the plot is redrawn

---

Notes

• Please make sure that you are using the latest version of Plotly, otherwise the click event might not work or is buggy
• In your original code the trace is drawn multiple times (remove showlegend to see it), probably because of add_markers()

---

Interactive JavaScript example

Plotly.d3.csv('https://raw.githubusercontent.com/plotly/datasets/master/3d-scatter.csv', function(err, rows) {
      function unpack(rows, key) {
        return rows.map(function(row) {
          return row[key];
        });
      }
      var trace1 = {
        x: unpack(rows, 'x1').slice(0, 30),
        y: unpack(rows, 'y1').slice(0, 30),
        z: unpack(rows, 'z1').slice(0, 30),
        mode: 'markers',
        marker: {
          size: 12,
          line: {
            color: 'rgba(217, 217, 217, 0.14)',
            width: 0.5
          },
          opacity: 0.8
        },
        type: 'scatter3d'
      };

      var trace3 = {
        x: [0],
        y: [0],
        z: [0],
        name: 'highlight',
        mode: 'markers',
        type: 'scatter3d',
        marker: {
          size: 24,
          opacity: 0.5
        }
      };
      var data = [trace1, trace3];
      var layout = {
        margin: {
          l: 0,
          r: 0,
          b: 0,
          t: 0
        }
      };
      
      myDiv = document.getElementById('myDiv');
      Plotly.newPlot(myDiv, data);

      myDiv.on('plotly_click', function(data) {
        var highlight_trace = myDiv.data.length - 1;
        //the coordinates of the point which was clicked on
        //is found in data
        var newPoint = {
          x: data.points[0].x,
          y: data.points[0].y,
          z: data.points[0].z
        };

        //update the plot data and redraw it
        if (myDiv.data[highlight_trace].x[0] != newPoint.x ||
          myDiv.data[highlight_trace].y[0] != newPoint.y ||
          myDiv.data[highlight_trace].z[0] != newPoint.z) {
          myDiv.data[highlight_trace].x[0] = newPoint.x;
          myDiv.data[highlight_trace].y[0] = newPoint.y
          myDiv.data[highlight_trace].z[0] = newPoint.z
          Plotly.redraw(myDiv);
        }
      });


    })

<script src="https://cdn.plot.ly/plotly-latest.min.js"></script>
<div id='myDiv'></div>