Make the value of the fill the actual fill in ggplot2

Question

Is there a way to have the value of the fill (the label) become the fill itself? For instance, in a stacked bar plot, I have

require(ggplot2)
big_votes_movies = movies[movies$votes > 100000,]
p = ggplot(big_votes_movies, aes(x=rating, y=votes, fill=year)) + geom_bar(stat="identity")

Can the values of 1997 and whatnot be the fill itself? A motif plot, if you will? An example of a motif plot is:

If this is possible, can I also plot these values on polar coordinates, so the fill would become the value?

p + coord_polar(theta="y")

Answer 1

There is a way to do it, but it's a little ugly.

When I first looked at it, I wondered if it could be done using geom_text, but although it gave a representation, it didn't really fit the motif structure. This was a first attempt:

require(ggplot2)

big_votes_movies = movies[movies$votes > 100000,]
p <- ggplot(big_votes_movies, aes(x=rating, y=votes, label=year))
p + geom_text(size=12, aes(colour=factor(year), alpha=0.3)) + geom_jitter(alpha=0) + 
  scale_x_continuous(limits=c(8, 9.5))   + scale_y_continuous(limits=c(90000,170000)) 

So then I realised you had to actually render the images within the grid/ggplot framework. You can do it, but you need to have physical images for each year (I created rudimentary images using ggplot, just to use only one tool, but maybe Photoshop would be better!) and then make your own grobs which you can add as custom annotations. You then need to make your own histogram bins and plot using apply. See below (it could be prettied up fairly easily). Sadly only works with cartesian co-ords :(

require(ggplot2)
require(png)
require(plyr)
require(grid)

years<-data.frame(year=unique(big_votes_movies$year))
palette(rainbow(nrow(years)))
years$col<-palette() # manually set some different colors

# create a function to write the "year" images
writeYear<-function(year,col){

  png(filename=paste(year,".png",sep=""),width=550,height=300,bg="transparent")
  im<-qplot(1,1,xlab=NULL,ylab=NULL) + 
    theme(axis.text.x = element_blank(),axis.text.y = element_blank()) +
    theme(panel.background = element_rect(fill = "transparent",colour = NA),     plot.background = element_rect(fill = "transparent",colour = NA), panel.grid.minor =     element_line(colour = "white")) +
    geom_text(label=year, size=80, color=col)
  print(im)
  dev.off()
}
#call the function to create the placeholder images
apply(years,1,FUN=function(x)writeYear(x["year"],x["col"]))

# then roll up the data
summarydata<-big_votes_movies[,c("year","rating","votes")]
# make own bins (a cheat)
summarydata$rating<-cut(summarydata$rating,breaks=c(0,8,8.5,9,Inf),labels=c(0,8,8.5,9))
aggdata <- ddply(summarydata, c("year", "rating"), summarise, votes  = sum(votes) )
aggdata<-aggdata[order(aggdata$rating),]
aggdata<-ddply(aggdata,.(rating),transform,ymax=cumsum(votes),ymin=c(0,cumsum(votes))[1:length(votes)])
aggdata$imgname<-apply(aggdata,1,FUN=function(x)paste(x["year"],".png",sep=""))

#work out the upper limit on the y axis
ymax<-max(aggdata$ymax)

#plot the basic chart
z<-qplot(x=10,y=10,geom="blank") + scale_x_continuous(limits=c(8,9.5)) + scale_y_continuous(limits=c(0,ymax))  

#make a function to create the grobs and call the annotation_custom function
callgraph<-function(df){
  tiles<-apply(df,1,FUN=function(x)return(annotation_custom(rasterGrob(image=readPNG(x["imgname"]),
                                                      x=0,y=0,height=1,width=1,just=c("left","bottom")),
                                                          xmin=as.numeric(x["rating"]),xmax=as.numeric(x["rating"])+0.5,ymin=as.numeric(x["ymin"]),ym    ax=as.numeric(x["ymax"]))))
      return(tiles)
    }

# then add the annotations to the plot
z+callgraph(aggdata)

and here's the plot with photoshopped images. I just save them over the generated imaages, and ran the second half of the script so as not to regenerate them.

OK - and then because it was bothering me, I decided to install extrafont and build the prettier graph using just R:

and here's the code:

  require(ggplot2)
  require(png)
  require(plyr)
  require(grid)
  require(extrafont)

  #font_import(pattern="Show") RUN THIS ONCE ONLY
  #load the fonts
  loadfonts(device="win")

  #create a subset of data with big votes
  big_votes_movies = movies[movies$votes > 100000,]

  #create a custom palette and append to a table of the unique years (labels) 
  years<-data.frame(year=unique(big_votes_movies$year))
  palette(rainbow(nrow(years)))
  years$col<-palette()

  #function to create the labels as png files
  writeYear<-function(year,col){

    png(filename=paste(year,".png",sep=""),width=440,height=190,bg="transparent")
    im<-qplot(1,1,xlab=NULL,ylab=NULL,geom="blank") + 
      geom_text(label=year,size=70, family="Showcard Gothic", color=col,alpha=0.8) +
      theme(axis.text.x = element_blank(),axis.text.y = element_blank()) +
      theme(panel.background = element_rect(fill = "transparent",colour = NA), 
            plot.background = element_rect(fill = "transparent",colour = NA), 
            panel.grid.minor = element_line(colour = "transparent"), 
            panel.grid.major = element_line(colour = "transparent"),
            axis.ticks=element_blank())
    print(im)
    dev.off()
  }

  #call the function to create the placeholder images
  apply(years,1,FUN=function(x)writeYear(x["year"],x["col"]))

  #summarize the data, and create bins manually
  summarydata<-big_votes_movies[,c("year","rating","votes")]
  summarydata$rating<-cut(summarydata$rating,breaks=c(0,8,8.5,9,Inf),labels=c(0,8,8.5,9))

  aggdata <- ddply(summarydata, c("year", "rating"), summarise, votes  = sum(votes) )
  aggdata<-aggdata[order(aggdata$rating),]
  aggdata<-ddply(aggdata,.(rating),transform,ymax=cumsum(votes),ymin=c(0,cumsum(votes))[1:length(votes)])
  #identify the image placeholders
  aggdata$imgname<-apply(aggdata,1,FUN=function(x)paste(x["year"],".png",sep=""))
  ymax<-max(aggdata$ymax)

  #do the basic plot
  z<-qplot(x=10,y=10,geom="blank",xlab="Rating",ylab="Votes \n",main="Big Movie Votes \n") + 
    theme_bw() +
    theme(panel.grid.major = element_line(colour = "transparent"),
          text = element_text(family="Kalinga", size=20,face="bold")        
          ) +
    scale_x_continuous(limits=c(8,9.5)) + 
    scale_y_continuous(limits=c(0,ymax))  

  #creat a function to create the grobs and return annotation_custom() calls
  callgraph<-function(df){
    tiles<-apply(df,1,FUN=function(x)return(annotation_custom(rasterGrob(image=readPNG(x["imgname"]),
                                                        x=0,y=0,height=1,width=1,just=c("left","bottom")),
                                                 xmin=as.numeric(x["rating"]),xmax=as.numeric(x["rating"])+0.5,ymin=as.numeric(x["ymin"]),ymax=as.numeric(x["ymax"]))))
    return(tiles)
  }
  #add the tiles to the base chart
  z+callgraph(aggdata)