plotly including multiple hyperlinks in text

Is there a way to hover over data in a plotly graph and then be able to click on a choice of hyperlinks within the text?

There are a number of questions (e.g., here, here) that allow the user to click on a point and that brings you to the url associated with that point but in those solutions it is restricted to only one url. For example:

library(ggplot2)
library(plotly)
library(htmlwidgets)
mydata <- data.frame( xx = c(1, 2),  yy = c(3, 4),
  website = c("https://www.google.com",
              "https://www.r-project.org/"),
  link = c(
    "https://www.google.com",
    "https://www.r-project.org/"))


g <- ggplot(mydata, aes(x = xx, y = yy, 
                        text = paste0("xx: ", xx, "\n",
                                      "website link: ", website),
                        customdata = link)) +
  geom_point()
g
p <- ggplotly(g, tooltip = c("text"))
p
onRender(
  p, "
  function(el) {
    el.on('plotly_click', function(d) {
      var url = d.points[0].customdata;
      window.open(url);
    });
  }
"
)

You can then click on the second point and it will bring you to https://www.r-project.org/ :

What I want is to be able to choice between two or more links (i.e. click on a hyperlink within the textbox):

mydata <- data.frame( xx = c(1, 2),  yy = c(3, 4),
                      website = c("https://www.google.com",
                                  "https://www.r-project.org/),
                      website2 = c(" https://www.reddit.com/", 
                                   "http://stackoverflow.com/"),
                      link = c(
                        "https://www.google.com, https://www.reddit.com/",
                        "https://www.r-project.org/, http://stackoverflow.com/"))


g <- ggplot(mydata, aes(x = xx, y = yy, 
                        text = paste0("xx: ", xx, "\n",
                                      "website link: ", website, "\n",
                                      "Second website: ", website2),
                        customdata = link)) +
  geom_point()
g
p <- ggplotly(g, tooltip = c("text"))
p

I sense this cannot be achieved with text or tooltip from plotly but perhaps there is a different workaround using e.g. javascript (which I am not familiar with).

Any ideas?

Thanks

Solution

Here is a way without Shiny, using the jqueryUI library:

library(plotly)
library(htmlwidgets)
library(htmltools)

dep <- htmlDependency(
  name = "jquery-ui",
  version = "1.13.2",
  src = c(href = "https://cdnjs.cloudflare.com/ajax/libs/jqueryui/1.13.2"),
  script = "jquery-ui.min.js",
  stylesheet = "themes/base/jquery-ui.min.css"
)


mydata <- data.frame(
  xx = c(1, 2),  
  yy = c(3, 4),
  website = c("https://www.google.com/",
              "https://www.r-project.org/"),
  website2 = c("https://www.reddit.com/", 
               "http://stackoverflow.com/"),
  link = I(list(
    list("https://www.google.com", "https://www.reddit.com/"),
    list("https://www.r-project.org/", "http://stackoverflow.com/")
  ))
)

g <- ggplot(
  mydata, 
  aes(
    x = xx, 
    y = yy, 
    text = paste0(
      "xx: ", xx, "\n",
      "website link: ", website, "\n",
      "Second website: ", website2
    ),
    customdata = link
  )) +
  geom_point()
p <- ggplotly(g, tooltip = c("text")) %>% onRender(
  "function(el) {
    el.on('plotly_click', function(d) {
      var urls = d.points[0].customdata;
      $div = $('<div><p><a href=\"' + urls[0] + '\">First link</a></p><p><a href=\"' + urls[1] + '\">Second link</a></p></div>');
      $div.dialog({
        autoOpen: false,
        show: {effect: 'blind', duration: 1000},
        hide: {effect: 'explode', duration: 1000}
      });
      $div.dialog('open');
    });
  }"
)
deps <- c(p$dependencies, list(dep))
p$dependencies <- deps

p

Using the SweetAlert2 library:

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

dep <- htmlDependency(
  name = "sweetalert2",
  version = "11.6.15",
  src = c(href = "https://cdnjs.cloudflare.com/ajax/libs/limonte-sweetalert2/11.6.15"),
  script = "sweetalert2.all.min.js"
)


mydata <- data.frame(
  xx = c(1, 2),  
  yy = c(3, 4),
  website = c("https://www.google.com/",
              "https://www.r-project.org/"),
  website2 = c("https://www.reddit.com/", 
               "http://stackoverflow.com/"),
  link = I(list(
    list("https://www.google.com", "https://www.reddit.com/"),
    list("https://www.r-project.org/", "http://stackoverflow.com/")
  ))
)

g <- ggplot(
  mydata, 
  aes(
    x = xx, 
    y = yy, 
    text = paste0(
      "xx: ", xx, "\n",
      "website link: ", website, "\n",
      "Second website: ", website2
    ),
    customdata = link
  )) +
  geom_point()
p <- ggplotly(g, tooltip = c("text")) %>% onRender(
  "function(el) {
    el.on('plotly_click', function(d) {
      var urls = d.points[0].customdata;
      var html = '<div><p>' + 
        '<a href=\"' + urls[0] + '\" target=\"_blank\">First link</a>' +
        '</p><p>' + 
        '<a href=\"' + urls[1] + '\" target=\"_blank\">Second link</a>' + 
        '</p></div>';
      Swal.fire({
        title: 'Links',
        html: html
      });
    });
  }"
)
deps <- c(p$dependencies, list(dep))
p$dependencies <- deps

p

More stylish:

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

dep <- htmlDependency(
  name = "sweetalert2",
  version = "11.6.15",
  src = c(href = "https://cdnjs.cloudflare.com/ajax/libs/limonte-sweetalert2/11.6.15"),
  script = "sweetalert2.all.min.js"
)


mydata <- data.frame(
  xx = c(1, 2),  
  yy = c(3, 4),
  link = I(list(
    list(
      list(title = "Google", url = "https://www.google.com"), 
      list(title = "Reddit", url = "https://www.reddit.com/")
    ),
    list(
      list(title = "R project", url = "https://www.r-project.org/"), 
      list(title = "StackOverflow", url = "http://stackoverflow.com/")
    )
  ))
)

g <- ggplot(
  mydata, 
  aes(
    x = xx, 
    y = yy, 
    text = paste0("xx: ", xx),
    customdata = link
  )) +
  geom_point()
p <- ggplotly(g, tooltip = c("text")) %>% onRender(
  "function(el) {
    el.on('plotly_click', function(d) {
      var urls = d.points[0].customdata;
      var html = '<hr/><div><p>' + 
        '<a href=\"' + urls[0].url + '\" target=\"_blank\">' + 
          urls[0].title + 
        '</a>' +
        '</p><p>' + 
        '<a href=\"' + urls[1].url + '\" target=\"_blank\">' + 
          urls[1].title +
        '</a>' + 
        '</p></div>';
      Swal.fire({
        title: '<strong>Links</strong>',
        html: html
      });
    });
  }"
)
deps <- c(p$dependencies, list(dep))
p$dependencies <- deps

p

You can also animate the sweet alerts with the Animate.css library:

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

dep_sweetalert2 <- htmlDependency(
  name = "sweetalert2",
  version = "11.6.15",
  src = c(href = "https://cdnjs.cloudflare.com/ajax/libs/limonte-sweetalert2/11.6.15"),
  script = "sweetalert2.all.min.js"
)
dep_animate.css <- htmlDependency(
  name = "animate.css",
  version = "4.1.1",
  src = c(href = "https://cdnjs.cloudflare.com/ajax/libs/animate.css/4.1.1"),
  stylesheet = "animate.min.css"
)


mydata <- data.frame(
  xx = c(1, 2),  
  yy = c(3, 4),
  link = I(list(
    list(
      list(title = "Google", url = "https://www.google.com"), 
      list(title = "Reddit", url = "https://www.reddit.com/")
    ),
    list(
      list(title = "R project", url = "https://www.r-project.org/"), 
      list(title = "StackOverflow", url = "http://stackoverflow.com/")
    )
  ))
)

g <- ggplot(
  mydata, 
  aes(
    x = xx, 
    y = yy, 
    text = paste0("xx: ", xx),
    customdata = link
  )) +
  geom_point()
p <- ggplotly(g, tooltip = c("text")) %>% onRender(
  "function(el) {
    el.on('plotly_click', function(d) {
      var urls = d.points[0].customdata;
      var html = '<hr/><div><p>' + 
        '<a href=\"' + urls[0].url + '\" target=\"_blank\">' + 
          urls[0].title + 
        '</a>' +
        '</p><p>' + 
        '<a href=\"' + urls[1].url + '\" target=\"_blank\">' + 
          urls[1].title +
        '</a>' + 
        '</p></div>';
      Swal.fire({
        title: '<strong>Links</strong>',
        html: html,
        showClass: {popup: 'animate__animated animate__rollIn'},
        hideClass: {popup: 'animate__animated animate__rollOut'}
      });
    });
  }"
)
deps <- c(p$dependencies, list(dep_sweetalert2, dep_animate.css))
p$dependencies <- deps

p