geom_bar() + pictograms, how to?

Question

(See bottom of post for updates)

Initial post, 2014-07-29 11:43:38Z

I saw this graphics on the Economist\'s website and wondered if it\'s possible to pro

Answer 1

gridSVG offers support for svg features unavailable to the R engine, such as fill patterns and arbitrary clipping. This example can easily be adapted for ggplot2,

library(grid)
library(gridSVG)
require(ggplot2)

p <- ggplot(df3, aes(what, units)) + 
  geom_bar(colour="black", stat="identity") +
  coord_flip()

pattern <- pattern(circleGrob(r=.4, gp=gpar(fill="grey")),
                   width=.05, height=.05)
registerPatternFill("circles", pattern)
gridsvg("pattern.svg")
print(p)
grid.force()
grid.patternFill("geom_rect.rect", grep=TRUE, group=FALSE,
                 label=rep("circles", length(levels(df3$what))))
dev.off()

Answer 2

Here's what I have come up with based on this idea. R logo taken from Wikipedia.

library(png)
fill_images <- function()
{
  l <- list()
  for (i in 1:nrow(df3)) 
  {
    for (j in 1:floor(df3$units[i]))
    {
      #seems redundant, but does not work if moved outside of the loop (why?)
      img <- readPNG("~/../Rlogo.png")
      g <- rasterGrob(img, interpolate=TRUE)
      l <- c(l, annotation_custom(g, xmin = i-1/2, xmax = i+1/2, ymin = j-1, ymax = j))
    }
  }
  l
}

p <- ggplot(df3, aes(what, units)) + 
  geom_bar(fill="white", colour="darkgreen", alpha=0.5, stat="identity") + 
  coord_flip() + 
  scale_y_continuous(breaks=seq(0, 20, 2)) + 
  scale_x_discrete() + 
  theme_bw() + 
  theme(axis.title.x  = element_blank(), axis.title.y  = element_blank()) + 
  fill_images()
p

I'm not quite sure what's the best way to draw partial images though.

Update:

Actually, that was easier than I had expected. I clip the image by drawing a white rectangle over a part of it. Note that geom_bar should be on top so that the clipping rectangle won't affect it. There was a minor issue with grid lines (they were partly hidden by these white rectangles), so I had to hardcode the position of these and restore them manually. Not an ideal solution, of course, but I don't know how to programmatically retrieve the grid position. Anyway, the final plot does the job and it also looks fancy!

library(png)
fill_images <- function()
{
  l <- list()
  for (i in 1:nrow(df3)) 
  {
    for (j in 1:ceiling(df3$units[i]))
    {
      img <- readPNG("~/../Rlogo.png")
      g <- rasterGrob(img, interpolate=TRUE)
      l <- c(l, annotation_custom(g, xmin = i-1/2, xmax = i+1/2, ymin = j-1, ymax = j))
    }
  }
  l
}

clip_images <- function(restore_grid = TRUE)
{
  l <- list()
  for (i in 1:nrow(df3)) 
  {
    l <- c(l, geom_rect(xmin = i-1/2, xmax = i+1/2, 
                        ymin = df3$units[i], ymax = ceiling(df3$units[i]),
                        colour = "white", fill = "white"))
    if (restore_grid && ceiling(df3$units[i]) %in% major_grid) 
      l <- c(l, geom_segment(x = i-1, xend = i+1,
                             y = ceiling(df3$units[i]), 
                             yend = ceiling(df3$units[i]),
                             colour = grid_col, size = grid_size))
  }
  l
}

grid_col <- "grey50"
grid_size <- 0.6
major_grid <- 0:10 * 2
p <- ggplot(df3, aes(what, units)) + 
  fill_images() + 
  clip_images() +
  geom_bar(fill=NA, colour="darkgreen", size=1.2, alpha=0.5, stat="identity") + 
  coord_flip() + 
  scale_y_continuous(breaks=seq(0, 20, 2)) + 
  scale_x_discrete() + 
  theme_bw() + 
  theme(axis.title.x  = element_blank(), axis.title.y  = element_blank(),
        panel.grid.major.x = element_line(colour = grid_col, size = grid_size), 
        panel.grid.major.y = element_line(colour = NA)) 
p

In order to save the .svg file, use e.g.

ggsave(file="test.svg", plot=p, width=10, height=8)

If you want to have a filling image as an .svg file, take a look at grImport package. It seems you'll have to convert .svg to .ps manually (e.g. with imagemagick), and then follow the guide.