javascript - plotly 中在文本中包含多个超链接

Question

有没有办法将鼠标悬停在 plotly 图表中的数据上，然后能够单击文本中的超链接选择？

有许多问题(例如 here 、 here )允许用户单击某个点并将您带到与该点关联的 URL，但在这些解决方案中，它仅限于一个网址。例如:

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

然后您可以单击第二个点，它将带您到 https://www.r-project.org/ :

我想要的是能够在两个或多个链接之间进行选择(即单击文本框中的超链接):

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

我感觉这无法通过 plotly 中的 text 或 tooltip 来实现，但也许有不同的解决方法，例如使用javascript(我不熟悉)。

有什么想法吗？

谢谢

Answer 1

这是一种不使用Shiny，使用jqueryUI库的方法:

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

---

使用SweetAlert2库:

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

---

更时尚:

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

---

您还可以使用 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