Search code examples
rggplot2shinyflexdashboard

R - Dynamically Changing PNG Images in GGPlot2 and Shiny

I'm generating a simple bar plot in ggplot2 and want to use shiny (via R Markdown) to be able to add a png image above the bars when the relevant value is selected in a selectizeInput() control.

Basically, in this example there is a data frame which has RD, OPP and FP, the x axis is RD, and y axis is FP. I can then use the selection tool to choose any number of the 5 OPP's.

When any of these OPP's are selected, I want the corresponding png image to sit on top (or near the top) of the corresponding bar in the chart. Note that the png images have been loaded with the same names as the terms in OPP.

I've tried to do this with an annotation_raster formula based on the advice at the following link but as mine is dynamic it isn't exactly the same and in fact tends to upset the chart. Create a Scatterplot of Raster Images in R

If anyone is able to help it would be greatly appreciated. Link to location of png files is here for completeness

---
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])
})
```
Solution

  • It seems that annotation_raster is not working so I implemented the solution using annotation_custom.

    First of all I restructured your code a little bit to make it easier to read

    1. setup chunk

      • Created a list of the logos to allow easier selection
      • Moved your basic_barchart to this chunk.

    Code:

    ```{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. Restructuring renderPlot

      • If there is no opponent selected, then we return the basic_barchart. This is efficient because we already defined it in the setup chunk, so Shiny doesn't need to recreate the ggplot object every time.
      • If opponent(s) are selected we add annotations to the plot. Here we introduced selected_logos and selected_stats to allow easier subsetting.

    Code:

    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)) 
  }
})

    And finally the result:

    Result