R - 在 GGPlot2 和 Shiny 中动态改变 PNG 图像

Question

我正在 ggplot2 中生成一个简单的条形图，并且希望在 selectizeInput() 控件中选择相关值时使用闪亮（通过 R Markdown）在条形上方添加 png 图像。

基本上，在这个例子中有一个数据框，它有 RD、OPP 和 FP，x 轴是 RD，y 轴是 FP。然后我可以使用选择工具选择 5 个 OPP 中的任意数量。

选择这些OPP中的任何一个时，我希望相应的PNG图像位于图表中相应栏的顶部（或附近）。请注意，已加载的 png 图像与 OPP 中的术语名称相同。

我已尝试根据以下链接中的建议使用 annotation_raster 公式来执行此操作，但由于我是动态的，因此它并不完全相同，实际上往往会扰乱图表。 Create a Scatterplot of Raster Images in R

如果有人能够提供帮助，将不胜感激。为了完整起见，指向 png 文件位置的链接是 here

---
title: "Raster Question for Stack Overflow"
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
runtime: shiny
---

```{r setup, include=FALSE}
library(flexdashboard)
library(png)
library(grid)
library(ggplot2)
stats<-data.frame(RD=c(1:5),OPP=c("ADEL","BL","ESS","SYD","HAW"),FP=c(40,45,60,30,50))
ADEL <- rasterGrob(readPNG("ADEL.png"), interpolate=TRUE) 
BL <- rasterGrob(readPNG("BL.png"), interpolate=TRUE) 
ESS <- rasterGrob(readPNG("ESS.png"), interpolate=TRUE) 
SYD <- rasterGrob(readPNG("SYD.png"), interpolate=TRUE) 
HAW <- rasterGrob(readPNG("HAW.png"), interpolate=TRUE) 

```

Column
-----------------------------------------------------------------------

### Plot

```{r, echo = FALSE}
  selectizeInput("opponent", label = "Select Opponent:",
          choices = stats$OPP, multiple = TRUE)

renderPlot({
  ggplot(stats,aes(RD,FP))+
  theme_bw()+
    theme(strip.background  = element_blank(),
         panel.grid.major = element_blank(),
         panel.border = element_blank(),
         axis.ticks = element_line(size = 0),
         panel.grid.minor.y = element_blank(),
         panel.grid.major.y = element_blank())+
  geom_bar(position="dodge",stat="identity",fill = "deepskyblue")+
    mapply(function(xx, yy, i) 
    annotation_raster(as.character(stats$OPP[stats$OPP %in% input$opponent])[[i]], 
    xmin=xx-0.5, xmax=xx+0.5, ymin=yy+5, ymax=yy+10),
    stats$RD[stats$OPP %in% input$opponent], 
    stats$FP[stats$OPP %in% input$opponent], 
    stats$OPP[stats$OPP %in% input$opponent])
})
```

Answer 1

似乎annotation_raster 不起作用，所以我使用annotation_custom 实现了解决方案。

首先，我对您的代码进行了一些重组，使其更易于阅读

1. setup块

   • 创建了logos 列表以便于选择
   • 已将您的 basic_barchart 移至此块。

代码：

```{r setup, include=FALSE}
library(flexdashboard)
library(png)
library(grid)
library(ggplot2)

stats<-data.frame(RD=c(1:5),OPP=c("ADEL","BL","ESS","SYD","HAW"),FP=c(40,45,60,30,50))
ADEL <- rasterGrob(readPNG("ADEL.png"), interpolate=TRUE) 
BL <- rasterGrob(readPNG("BL.png"), interpolate=TRUE) 
ESS <- rasterGrob(readPNG("ESS.png"), interpolate=TRUE) 
SYD <- rasterGrob(readPNG("SYD.png"), interpolate=TRUE) 
HAW <- rasterGrob(readPNG("HAW.png"), interpolate=TRUE) 

logos <- list(ADEL = ADEL, BL = BL, ESS = ESS, SYD = SYD, HAW = HAW)

basic_barchart <- ggplot(stats,aes(RD,FP))+
  theme_bw()+
    theme(strip.background  = element_blank(),
         panel.grid.major = element_blank(),
         panel.border = element_blank(),
         axis.ticks = element_line(size = 0),
         panel.grid.minor.y = element_blank(),
         panel.grid.major.y = element_blank())+
  geom_bar(position="dodge",stat="identity",fill = "deepskyblue")
```

1. 重组renderPlot

   • 如果没有选择opponent，那么我们返回basic_barchart。这很有效，因为我们已经在 setup chunk 中定义了它，所以 Shiny 不需要每次都重新创建 ggplot 对象。
   • 如果选择了对手，我们会在绘图中添加注释。在这里，我们引入了selected_logos 和selected_stats，以便更轻松地进行子集化。

代码：

renderPlot({
  if(is.null(input$opponent)) {
    basic_barchart
  } else {
    selected_logos <- subset(logos, names(logos) %in% input$opponent)
    selected_stats <- subset(stats, OPP %in% input$opponent)

    basic_barchart +
      mapply(function(xx, yy, i)
        annotation_custom(selected_logos[[i]], xmin=xx-0.5, xmax=xx+0.5, ymin=yy-5, ymax=yy+5),
        selected_stats$RD, selected_stats$FP, 1:length(selected_logos)) 
  }
})

最后是结果：