有没有办法将本地存储的图像读取到 Plotly 中？

Question

在another user has successfully demonstrated 下面的代码中，解决了如何将图像 URL 加载到 Plotly 图中的方法。图像数据取自数据框，然后通过使用自定义数据工具，在图表中的每个数据点悬停时显示为工具提示。有没有办法使用本地存储的图像来做类似的事情，只需使用文件目录？

library(shiny)
library(shinydashboard)
library(plotly)

# Data ------------------------------------------------------------------
dt <- data.frame(
  fruits = c("apple", "banana", "oranges"),
  rank = c(11, 22, 33),
  image_url = c(
    'https://images.unsplash.com/photo-1521671413015-ce2b0103c8c7?ixlib=rb-0.3.5&s=45547f67f01ffdcad0e33c8417b840a9&auto=format&fit=crop&w=667&q=80',
    "https://images.unsplash.com/photo-1520699697851-3dc68aa3a474?ixlib=rb-0.3.5&ixid=eyJhcHBfaWQiOjEyMDd9&s=ef15aee8bcb3f5928e5b31347adb6173&auto=format&fit=crop&w=400&q=80",
    "https://images.unsplash.com/photo-1501925873391-c3cd73416c5b?ixlib=rb-0.3.5&ixid=eyJhcHBfaWQiOjEyMDd9&s=379e4a0fffc6d11cd5794806681d0211&auto=format&fit=crop&w=750&q=80"
  )
)

# Dashboard ----------------------------------------------------------------
ui <- dashboardPage(
  dashboardHeader(title = "Test"),
  dashboardSidebar(),
  dashboardBody(tags$head(tags$style(
    HTML("img.small-img {
          max-width: 75px;
          }")
  )),
  plotlyOutput("hoverplot"))
)

server <- function(input, output, session) {
  output$hoverplot <- renderPlotly({
    plot_ly(
      dt,
      x         = ~ fruits,
      y         = ~ rank,
      type      = 'scatter',
      mode      = 'markers',
      hoverinfo = 'none',
      source = "hoverplotsource",
      customdata = ~ image_url
    ) %>%
      event_register('plotly_hover') %>%
      event_register('plotly_unhover')
  })

  hover_event <- reactive({
    event_data(event = "plotly_hover", source = "hoverplotsource")
  })

  unhover_event <- reactive({
    event_data(event = "plotly_unhover", source = "hoverplotsource")
  })

  hoverplotlyProxy <- plotlyProxy("hoverplot", session)

  observeEvent(unhover_event(), {
    hoverplotlyProxy %>%
      plotlyProxyInvoke("relayout", list(images = list(NULL)))
  })

  observeEvent(hover_event(), {
    hoverplotlyProxy %>%
      plotlyProxyInvoke("relayout", list(images = list(
        list(
          source = hover_event()$customdata,
          xref = "x",
          yref = "y",
          x = hover_event()$x,
          y = hover_event()$y,
          sizex = 20,
          sizey = 20,
          opacity = 1
        )
      )))
  })
}

shinyApp(ui = ui, server = server)

Answer 1

您需要将存储本地图像的目录作为静态资源添加到 Shiny 的 Web 服务器。这可以通过addResourcePath：

library(shiny)
library(shinydashboard)
library(plotly)

ui <- dashboardPage(
  dashboardHeader(title = "Test"),
  dashboardSidebar(),
  dashboardBody(tags$head(tags$style(
    HTML("img.small-img {
          max-width: 75px;
          }")
  )),
  plotlyOutput("hoverplot"))
)

server <- function(input, output, session) {
  
  # create some local images
  if(!dir.exists("myimages")){
    dir.create("myimages")
  }
  
  myPlots <- paste0("myimages/myplot", seq_len(3), ".png")
  
  for (myPlot in myPlots) {
    png(file = myPlot, bg = "transparent")
    plot(runif(10))
    dev.off() 
  }
  
  myImgResources <- paste0("imgResources/myplot", seq_len(3), ".png")
  
  dt <- data.frame(
    fruits = c("apple", "banana", "oranges"),
    rank = c(11, 22, 33),
    image_url = myImgResources
  )
  
  # Add directory of static resources to Shiny's web server
  addResourcePath(prefix = "imgResources", directoryPath = "myimages")
  
  output$hoverplot <- renderPlotly({
    plot_ly(
      dt,
      x         = ~ fruits,
      y         = ~ rank,
      type      = 'scatter',
      mode      = 'markers',
      hoverinfo = 'none',
      source = "hoverplotsource",
      customdata = ~ image_url
    ) %>%
      event_register('plotly_hover') %>%
      event_register('plotly_unhover')
  })
  
  hover_event <- reactive({
    event_data(event = "plotly_hover", source = "hoverplotsource")
  })
  
  unhover_event <- reactive({
    event_data(event = "plotly_unhover", source = "hoverplotsource")
  })
  
  hoverplotlyProxy <- plotlyProxy("hoverplot", session)
  
  observeEvent(unhover_event(), {
    hoverplotlyProxy %>%
      plotlyProxyInvoke("relayout", list(images = list(NULL)))
  })
  
  observeEvent(hover_event(), {
    hoverplotlyProxy %>%
      plotlyProxyInvoke("relayout", list(images = list(
        list(
          source = hover_event()$customdata,
          xref = "x",
          yref = "y",
          x = hover_event()$x,
          y = hover_event()$y,
          sizex = 20,
          sizey = 20,
          opacity = 1
        )
      )))
  })
}

shinyApp(ui = ui, server = server)

作为替代方案，您可以将图像存储在 www 文件夹（应用文件夹的子目录）中，然后您可以不带前缀访问图像。

---

更新：这是另一个使用base64enc::dataURI而不是addResourcePath的版本：

library(base64enc)
library(shiny)
library(shinydashboard)
library(plotly)

ui <- dashboardPage(
  dashboardHeader(title = "Test"),
  dashboardSidebar(),
  dashboardBody(tags$head(tags$style(
    HTML("img.small-img {
          max-width: 75px;
          }")
  )),
  plotlyOutput("hoverplot"))
)

server <- function(input, output, session) {
  
  # create some local images
  if(!dir.exists("myimages")){
    dir.create("myimages")
  }
  
  myPlots <- paste0("myimages/myplot", seq_len(3), ".png")
  
  for (myPlot in myPlots) {
    png(file = myPlot, bg = "transparent")
    plot(runif(10))
    dev.off() 
  }
  
  myImgResources <- vapply(myPlots, function(x){base64enc::dataURI(file = x)}, FUN.VALUE = character(1L))
  
  dt <- data.frame(
    fruits = c("apple", "banana", "oranges"),
    rank = c(11, 22, 33),
    image_url = myImgResources
  )
  
  output$hoverplot <- renderPlotly({
    plot_ly(
      dt,
      x         = ~ fruits,
      y         = ~ rank,
      type      = 'scatter',
      mode      = 'markers',
      hoverinfo = 'none',
      source = "hoverplotsource",
      customdata = ~ image_url
    ) %>%
      event_register('plotly_hover') %>%
      event_register('plotly_unhover')
  })
  
  hover_event <- reactive({
    event_data(event = "plotly_hover", source = "hoverplotsource")
  })
  
  unhover_event <- reactive({
    event_data(event = "plotly_unhover", source = "hoverplotsource")
  })
  
  hoverplotlyProxy <- plotlyProxy("hoverplot", session)
  
  observeEvent(unhover_event(), {
    hoverplotlyProxy %>%
      plotlyProxyInvoke("relayout", list(images = list(NULL)))
  })
  
  observeEvent(hover_event(), {
    hoverplotlyProxy %>%
      plotlyProxyInvoke("relayout", list(images = list(
        list(
          source = hover_event()$customdata,
          xref = "x",
          yref = "y",
          x = hover_event()$x,
          y = hover_event()$y,
          sizex = 20,
          sizey = 20,
          opacity = 1
        )
      )))
  })
}

shinyApp(ui = ui, server = server)