geom_bar() + pictograms, how to?
Asked Answered
P

2

15

(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 produce a geom_bar() with this kinda illustrative icons imbedded? (dummy data below)

enter image description here

Dummy data,

require(ggplot2)

# Generate data
df3 <- data.frame(units = c(1.3, 1.8, 2.7, 4.2, 4.7, 6.7, 20), 
                   what = c('Wikipedia', 'London Olympic Park', 'Aircraft carrier', 
                            'The Great Pyramid', 'Stonehenge', 'Burj Khalifas', 
                            'Empire State Building'))

# make gs an ordered factor
df3$what <- factor(df3$what, levels = df3$what, ordered = TRUE)

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

enter image description here

Update #1, 2014-07-29 15:07:51Z

Apparently Robert Grant has started to build an R function to produce bar-charts with pictograms, it can be found at Github. Thanks to Andrie for that information. I'm currently working to see if Robert's function can do what I am looking for.

Please chime in if you have any advice on how to answer my question using Robert's function.

Update #2, 2014-08-02 12:35:19Z

Here is a simple illustration of how Grant's R-pictogram-function work

# in case you don't alredy have RCurl
# install.packages("RCurl", dependencies = TRUE)
source_github <- function(u) {
  # load package
  require(RCurl)

  # read script lines from website and evaluate
  script <- getURL(u, ssl.verifypeer = FALSE)
  eval(parse(text = script),envir=.GlobalEnv)
}

Got this script form this SO answer

source_github("https://raw.githubusercontent.com/robertgrant/pictogram/master/pictogram.R")

# install.packages("png", dependencies = TRUE)
  require(png)

img <- readPNG(system.file("img", "Rlogo.png", package="png"))
pictogram(icon = img, n = c( 12, 35, 7),
grouplabels=c("12 R logos","35 R logos","7 R logos"))

This gives you this kinda plot R logos

Paternal answered 29/7, 2014 at 11:43 Comment(5)
It's called a pictogram. A google search will give many results, including this one: r-bloggers.com/easy-pictograms-using-rKarinakarine
have a look at rpatternGrob in gridExtra; the code is ugly but the purpose is similar to your request.Hardening
I believe the authors of the gridSVG package have been presenting some ideas to tweak (postprocess) svg files. SVG supports clipping and fill patterns natively, that would be a more elegant approach in my opinion.Hardening
@baptiste, sounds interesting, thanks. I'm looking at the gridSVG Reference manual (PDF!) now.Paternal
here's a complete example.Hardening
E
9

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

enter image description here

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

enter image description here

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.

Engine answered 1/8, 2014 at 7:55 Comment(4)
Thank you for responding to my question. It's an interesting start. Grant's function, mentioned in my question, has similar unresolved issues. I've added a update were you can see it in use.Paternal
Very interesting! Do you know if would be possible to do this with Scalable Vector Graphics (SVG)? I think that's my goal, but I really appreciate you picked it up again and improve your answer!Paternal
Do you mean to use .svg as an input file? Or to save the plot as .svg? Or...?Engine
The former is very simple; the latter is not (see edit). I haven't tried the grImport way, but the image simply obtained with ggsave with raster R logo in it looks fine (at least if the .png logo is at about 300x300), so it might be enough.Engine
H
6

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,

enter image description here

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()
Hardening answered 6/8, 2014 at 8:3 Comment(1)
thank you for taking the time to response to my question. Looks interesting, however it's more of a fill pattern then a fill pictogram. As you also point out `implementing fill patterns with grid graphics is a rather hopeless pursuit.' However, I appreciate the input!Paternal

© 2022 - 2024 — McMap. All rights reserved.