Add specific hovering behaviour to R plotly graphic

Question

I am having troubles defining a specific behaviour when hovering an R Plotly graphic. Here is what I would like to do : I would like the full arrow to be responsive, here it is just the tip of the arrow. I would also like, when the users hovers an arrow that this arrow stay with its opacity but the other ones have added transparency. Is it possible with plotly ? I tried some htmlwidgets onRender options but could not find a way to add the styles to all the other arrows except the one hovered.

Here is a repex :

library(ade4)
library(plotly)
library(FactoMineR)
data("decathlon")
res.pca <- dudi.pca(decathlon[, -13], scannf = FALSE, nf = 5)

res.pca.coord <- res.pca$co

res.pca.coord$Comp1init <- rep(0, nrow(res.pca.coord))
res.pca.coord$Comp2init <- rep(0, nrow(res.pca.coord))

t <- list(
  family = "sans serif",
  size = 14,
  color = toRGB("grey50"))

plot_ly(res.pca.coord, x = ~Comp1, y = ~Comp2, text = rownames(res.pca.coord)) %>% 
  layout(shapes = list(
    list(type = 'circle',
         xref = 'x', x0 = -1, x1 = 1,
         yref = 'y', y0 =  -1, y1 = 1,
         line = list(color = 'blue')))) %>% 
  add_text(textfont = t, 
           textposition = ifelse(res.pca.coord$Comp2 > 0 & res.pca.coord$Comp1 > 0, 'top right', 
                                 ifelse(res.pca.coord$Comp2 > 0 & res.pca.coord$Comp1 < 0, 'top left',
                                        ifelse(res.pca.coord$Comp2 < 0 & res.pca.coord$Comp1 < 0, 'bottom left', 'bottom right')))) %>% 
  add_annotations( x = ~Comp1,
                   y = ~Comp2,
                   xref = "x", yref = "y",
                   axref = "x", ayref = "y",
                   text = "",
                   showarrow = T,
                   ax = ~Comp1init,
                   ay = ~Comp2init)

Answer 1

This isn't a simple implementation. If there's an easier way, I'm unsure what that looks like. That being said, the first bit of code is Javascript. It's essentially the same coding you'd use for updatemenus if you were using buttons in a different programming language.

This doesn't change the opacity; it simulates an opacity change. This makes the arrow black for the point you hover on and changes the other arrows to light gray. When you 'unhover' it reverts the arrows back to their original color.

hoverer = "function(el, x) {
            el.on('plotly_hover', function(d){
              var pn = d.points[0].pointNumber;
              var nCol = Array(12).fill('lightgray');
              nCol[pn] = '#000';
              var xer = d.points[0].data.x;
              var yer = d.points[0].data.y;
              var ann = [];
              for(i = 0; i < xer.length; i++){ 
                ann[i] = {
                  'text': '', 
                  'x': xer[i], 
                  'y': yer[i], 
                  'axref': 'x', 'ayref': 'y', 
                  'arrowcolor': nCol[i], 
                  'showarrow': true, 
                  'ax': 0, 'ay': 0}};
              a2 = {annotations: ann};
              Plotly.relayout(el.id, a2);
            });
            el.on('plotly_unhover', function(d){
              var xer = d.points[0].data.x;
              var yer = d.points[0].data.y;
              var ann = [];
              for(i = 0; i < xer.length; i++){ 
                ann[i] = {
                  text: '', 
                  x: xer[i], 
                  y: yer[i], 
                  axref: 'x', ayref: 'y', 
                  arrowcolor: '#444', 
                  showarrow: true, 
                  ax: 0, ay: 0}};
              Plotly.relayout(el.id, {annotations: ann});
            });}"

Now you add this Javascript to your plot. For this to work, you need to call the library htmlwidgets or append it to the function call, as I did here.

plot_ly(res.pca.coord, x = ~Comp1, y = ~Comp2, text = rownames(res.pca.coord)) %>% 
  layout(shapes = list(
    list(type = 'circle',
         xref = 'x', x0 = -1, x1 = 1,
         yref = 'y', y0 =  -1, y1 = 1,
         line = list(color = 'blue')))) %>% 
  add_text(textfont = t, 
           textposition = ifelse(
             res.pca.coord$Comp2 > 0 & res.pca.coord$Comp1 > 0, 'top right', 
             ifelse(
               res.pca.coord$Comp2 > 0 & res.pca.coord$Comp1 < 0, 'top left',
               ifelse(
                 res.pca.coord$Comp2 < 0 & res.pca.coord$Comp1 < 0, 
                 'bottom left', 'bottom right')))) %>% 
  add_annotations( x = ~Comp1,
                   y = ~Comp2,
                   xref = "x", yref = "y",
                   axref = "x", ayref = "y",
                   text = "",
                   arrowcolor = '#444',
                   showarrow = T,
                   ax = ~Comp1init,
                   ay = ~Comp2init) %>% 
  htmlwidgets::onRender(hoverer)