Tooltip inserting image and/or ggplot in plotly R

Question

I want to edit the tooltip hover feature in a 3D UMAP I created within plotly. What I want to do is attach a saved image corresponding to a specific 'Sample.Code' and have that image appear when I hover over it in the 3D plotly scatter plot.

This would be similar to the interactive t-SNE/MNIST dataset that is attached in this link: https://dash.plotly.com/dash-core-components/tooltip

However, the above was written out in python not R. Would it be possible to achieve this in R?

I have attached my code below:

    # load ggplot2
library(ggplot2)
library(hrbrthemes)
library(tidyverse)
library(dplyr)
library(wesanderson)
library(RColorBrewer)
library(manipulate)
library(umap)
library(plotly)
library(shiny)
library(leaflet)

#set wd to location where plots will be saved. First step is to upload the initial data. 

dt <- read.csv('data.csv')

#Run to the UMAP

df <- as.matrix(dt[, 2:149]) #remember to only set columns which will be used in the UMAP calculation

  custom.config = umap.defaults  #manual settings
  custom.config$n_components = 3
  custom.config$n_neighbors = 8
  custom.config$min_dist = 0.6
  
data_umap <-umap(df, config = custom.config)
  
data_raw<-as.data.frame(data_umap$layout)

data_plot <- cbind(data_raw, dt)

  #running graphics script. Make sure to change color and size to appropriate labels
  #This is the visual that will get manipulated playing around with the UMAP parameters
  
UMAP_plot <- ggplot(data_plot, aes(x = V1, y = V3, color = Dataset)) +
    labs(title = '2D UMAP') +
    geom_point(alpha = 0.7, shape =19 ) + 
    theme_light() +
    theme(axis.text.y = element_text(size = 15),
          axis.text.x = element_text(size = 10),
          axis.title = element_text(size = 15),
          plot.title = element_text(size = 17),
          legend.text = element_text(size=15)) +
    scale_radius(range=c(4, 10))

colors <- c('#4AC6B7', '#1972A4', '#965F8A', '#FF7070', 'darkolivegreen')
  
UMAP_2D <- plot_ly(data_plot, x= ~V1, y= ~V3, color = ~Dataset, colors=colors,  type = "scatter", mode = "markers", text = ~paste('Sample.Code:', Sample.Code))

UMAP_3D <- plot_ly(data_plot, x= ~V1, y= ~V2, z= ~V3, type="scatter3d", mode="markers", color = ~Dataset, colors=colors, text = ~paste('Sample.Code:', Sample.Code))

UMAP_3D <- UMAP_3D %>% layout(title = '3D UMAP',
                             paper_bgcolor = 'grey',
                             plot_bgcolor = 'black')

UMAP_3D.update_layout(legend=dict(
  yanchor="top",
  y=0.99,
  xanchor="left",
  x=0.01
))

#Eventually add fingerprints to hover based on this code here: https://anchormen.nl/blog/data-science-ai/images-in-plotly-with-r/


print(UMAP_plot)
print(UMAP_2D)
print(UMAP_3D)

Answer 1

Per your comment, I can definitely use the data from the Plotly example. I haven't purchased Dash, but you could certainly do that and make this easier on yourself. (I think. I haven't used it; so I'm guessing.)

Without Dash, using the Python example, I essentially recreated that graph in R with Plotly. I did not use ggplot.

I used two libraries, but I appended the library name the only time I used htmlwidgets.

First, the data is collected from the same place as in the Python example, but I only used the first 100 rows. Next, I add line break tags into the descriptions. There is no string wrapping in SVG text. Each line is tagged separately. I used 65 characters, give or take a whole word. you could modify this based on the size of tooltips you're looking for.

After that, I created the basic plot. I added all of the content I could into the tooltips, so I would only have to make a few adjustments. Plotly renders all content as text in a tooltip, so I added several line breaks (18), so that there would be space for the images. I also added some styling in the tooltip (like "darkblue" text for the 'NAME' element).

In the JS (everything in htmlwidgets::onRender), you need to gather the content in the tooltip, remove the line breaks with no text, and retrofit the image URLs as <image> elements.

This requires getting the positions and available space. This requires determining whether the tooltip is to the left of the point, to the right of the point, or if the text is centered in the tooltip. For the points with extended descriptions, things were off, so that required some adjustments, as well. I added a lot of comments in the JS, so that should explain the purpose of a lot of the code, as well.

If you have questions, let me know.

library(plotly)

# get molecular data
dp <- read.csv("https://raw.githubusercontent.com/plotly/dash-sample-apps/main/apps/dash-drug-discovery/data/small_molecule_drugbank.csv")

# because even SVG doesn't string wrap, each row is a separate tag
dp$desc <- gsub('(.{1,65})(\\s|$)', '\\1<br>', dp$DESC)

plt <- plot_ly(
  dp[1:100, ], x = ~LOGP, y = ~PKA, mode = "markers", type = "scatter",
  marker = list(colorscale = "Viridis",
                color = ~MW, size = ~MW,
                colorbar = list(title = "Molecule<br>Weight",
                                outlinewidth = 0), # just looks better without you!
                line = list(color = "#444"),
                reversescale = T, sizeref = 45,
                sizemode = "diameter", opacity = .8),
  customdata = ~IMG_URL,
  text = ~NAME, hovertext = ~desc,
  hovertemplate = paste0(  # 'here' is used for regex in JS
    "image href='%{customdata}' here ",  # 18 <br> make space for image (see in JS where 18 matters)
    "<br><br><br><br><br><br><br><br><br><br><br><br><br><br><br><br><br><br>",
    "<span style='fill:darkblue;font-size:2em;'>%{text}</span><br>",
    "<span>%{hovertext}</span><extra></extra>")) %>% 
  layout(xaxis = list(title = "Log P"), yaxis = list(title = "pkA"),
         plot_bgcolor = "#1a1a1a", paper_bgcolor = "#0d0d0d", # almost and off black
         hoverdistance = 10) %>%                              # more precision in selection
  htmlwidgets::onRender("function(el){
    console.log(el);
    setInterval(function(){              /* no content when tip is called; keep looking */
      tt = document.querySelector('#' + el.id + '> div > div > svg:nth-child(5) > g');
    },100);
    el.on('plotly_hover', function(d){
      if(tt.firstChild) {
        cvy = parseFloat(getComputedStyle(tt).fontSize);      /* em to px conversion */
        str = tt.innerHTML;
        gimme = /image.*(?=( here \\<br))/.exec(str);         /* extract image details */
        x = /(?<=(data-notex=\"1\" x=\")).*(?=(\" y=.*data))/g.exec(str);/* image x */
        y = /(?<=(y=\")).*(?=(\" data-unformatted))/g.exec(str);         /* image y */
        bc = tt.getBoundingClientRect();
        wbc = bc.width;
        hbc = bc.height;
        if(/-/.exec(x[0])) wwbc = (wbc * -1) - Number(x[0]);  /* adjust x if tip to the left */
        if(/-/.exec(x[0]) === null) wwbc = Number(x[0]);      /* adjust x if tip to the right */
        if(x[0] == 0) wwbc = wbc * -.5;                       /* if text is centered */
        ts = str.match(/\\<tspan?.*?\\/tspan\\>/gm);          /* all tspans indexed */
        dy = /(?<=(dy=\")).*(?=( x=))/g.exec(ts[18]);         /* 18th break in the template (18 br's coded) */
        dyc = /.*(?=(em))/.exec(dy[0]);                       /* collect digits; remove units */
        cdy = cvy * Number(dyc[0]);                           /* convert em to px for image ht */
        if(cdy > hbc * .75) cdy = hbc * .65;                  /* if em => px is larger than plot, reduce */
        wbcw = wbc - Math.abs(Number(x[0]) * 2);              /* get width for image */
        if(ts.length >= 34) {
          y[0] = Number(y[0]) * 1.1;               /* lots of text images are low & too large */
          cdy = cdy * .9;
        }
        beg = str.match(/.*(?=(\\<text))/);                   /* everything up to text tags */
        jn = '\\<' + gimme[0] + ' x=\"' + wwbc + '\" y=\"' + y[0]; /* the image; can't crtl aspect ratio——Plotly-ism? */                           
        jn = jn + '\" height=\"' + cdy + '\" width=\"' + wbcw +'\"\\/\\>';  
        tx = str.match(/\\<text.*pre\\;\"\\>?/);              /* text element before tspan */
        nts = ts.slice(18, ts.length).join('\\<\\/tspan\\>'); /* reassemble kept tspans */
        clt = '\\<\\/text\\>\\<\\/g\\>';                      /* closing tags */
        altog = beg[0] + jn + tx[0] + nts + clt;              /* put it together */
        tt.innerHTML = altog;                                 /* replace tooltip */
      }
    });
  }")