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

Question

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

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

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

我已经尝试根据以下 link 中的建议使用 annotation_raster 公式来做到这一点，但由于我的是动态的，它并不完全相同，事实上往往会令人不安图表。

如果有人能提供帮助，我们将不胜感激。 Link 到 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 实现了解决方案。

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

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")
```

重组renderPlot
- 如果没有选择opponent，那么我们return basic_barchart。这是有效的，因为我们已经在设置块中定义了它，所以 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)) 
  }
})

最后的结果是：

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

R - Dynamically Changing PNG Images in GGPlot2 and Shiny

r

ggplot2

shiny

flexdashboard