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

Question

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

基本上，在这个例子中有一个数据帧，它有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 chunk

   • 创建了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。这是有效的，因为我们已经在设置块中定义了它，因此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)) 
  }
})

最后结果：