plotly including multiple hyperlinks in text-CodePudding

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.,

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

CodePudding user response：

Here is a way with Shiny:

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

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;
      Shiny.setInputValue('urls', urls);
    });
  }"
)


ui <- fluidPage(
  plotlyOutput("plotly")
)

server <- function(input, output, session) {
  
  output[["plotly"]] <- renderPlotly({
    p
  })
  
  observeEvent(input[["urls"]], {
    url1 <- input[["urls"]][1]
    url2 <- input[["urls"]][2]
    showModal(modalDialog(
      tags$div(
        tags$a(href = url1, "First link"),
        tags$br(),
        tags$a(href = url2, "Second link")
      )
    ))
  })
  
}

shinyApp(ui, server)

CodePudding user response：

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