Heatmaps for 3x3 game matrices in R language

heatmaps.R

library(ggplot2)
library(reshape2)

# Multiple plot function
#
# ggplot objects can be passed in ..., or to plotlist (as a list of ggplot objects)
# - cols:   Number of columns in layout
# - layout: A matrix specifying the layout. If present, 'cols' is ignored.
#
# If the layout is something like matrix(c(1,2,3,3), nrow=2, byrow=TRUE),
# then plot 1 will go in the upper left, 2 will go in the upper right, and
# 3 will go all the way across the bottom.
#
multiplot <- function(..., plotlist=NULL, file, cols=1, layout=NULL) {
   library(grid)

   # Make a list from the ... arguments and plotlist
   plots <- c(list(...), plotlist)

   numPlots = length(plots)

   # If layout is NULL, then use 'cols' to determine layout
   if (is.null(layout)) {
      # Make the panel
      # ncol: Number of columns of plots
      # nrow: Number of rows needed, calculated from # of cols
      layout <- matrix(seq(1, cols * ceiling(numPlots/cols)),
                       ncol = cols, nrow = ceiling(numPlots/cols))
   }

   if (numPlots==1) {
      print(plots[[1]])

   } else {
      # Set up the page
      grid.newpage()
      pushViewport(viewport(layout = grid.layout(nrow(layout), ncol(layout))))

      # Make each plot, in the correct location
      for (i in 1:numPlots) {
         # Get the i,j matrix positions of the regions that contain this subplot
         matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE))

         print(plots[[i]], vp = viewport(layout.pos.row = matchidx$row,
                                         layout.pos.col = matchidx$col))
      }
   }
}

winners_min_expd1 <- matrix(c(NA, 5, 5, 0, NA, 0, 2, 2, NA), nrow=3, ncol=3, byrow = T)
winners_min_expd0 <- matrix(c(NA, 2, 2, 3, NA, 3, 2, 2, NA), nrow=3, ncol=3, byrow = T)

colnames(winners_min_expd1) <- c("homophily","heterophily","preferential")
colnames(winners_min_expd0) <- c("homophily","heterophily","preferential")

rownames(winners_min_expd1) <- c("homophily","heterophily","preferential")
rownames(winners_min_expd0) <- c("homophily","heterophily","preferential")

melted_min_expd1 <- melt(winners_min_expd1)
melted_min_expd0 <- melt(winners_min_expd0)

colnames(melted_min_expd1) <- c("winning", "looses", "times")
colnames(melted_min_expd0) <- c("winning", "looses", "times")

p_min_expd1 <- ggplot(melted_min_expd1, aes(looses, winning)) +
   geom_tile(aes(fill = cut(times, breaks=-1:5, labels=0:5)), colour = "grey") +
   scale_fill_manual(drop=FALSE, values=colorRampPalette(c("white","red"))(6), na.value="#EAEAEA", name="Times") +
   xlab("looses against") + ylab("winning over") +
   ggtitle("Min() function, experience decay ON") +
   scale_y_discrete(limits=c("preferential", "heterophily", "homophily"))
p_min_expd0 <- ggplot(melted_min_expd0, aes(looses, winning)) +
   geom_tile(aes(fill = cut(times, breaks=-1:5, labels=0:5)), colour = "grey") +
   scale_fill_manual(drop=FALSE, values=colorRampPalette(c("white","red"))(6), na.value="#EAEAEA", name="Times") +
   xlab("looses against") + ylab("winning over") +
   ggtitle("Min() function, experience decay OFF") +
   scale_y_discrete(limits=c("preferential", "heterophily", "homophily"))

multiplot(p_min_expd1, p_min_expd0, cols=1)