Skip to content

Instantly share code, notes, and snippets.

@sheymann
Created April 16, 2012 15:58
Show Gist options
  • Save sheymann/2399649 to your computer and use it in GitHub Desktop.
Save sheymann/2399649 to your computer and use it in GitHub Desktop.
R tip: Make a ggplot output ready for publication
# ----------------------------------------------------------------------------
# Rudolf Cardinal, March 2011
# Simple extensions to ggplot2 (v0.8.7); see http://www.psychol.cam.ac.uk/statistics/R/
# ----------------------------------------------------------------------------
theme_L_border <- function(colour = "black", size = 1, linetype = 1) {
# use with e.g.: ggplot(...) + opts( panel.border=theme_L_border() ) + ...
structure(
function(x = 0, y = 0, width = 1, height = 1, ...) {
polylineGrob(
x=c(x+width, x, x), y=c(y,y,y+height), ..., default.units = "npc",
gp=gpar(lwd=size, col=colour, lty=linetype),
)
},
class = "theme",
type = "box",
call = match.call()
)
}
theme_bottom_border <- function(colour = "black", size = 1, linetype = 1) {
# use with e.g.: ggplot(...) + opts( panel.border=theme_bottom_border() ) + ...
structure(
function(x = 0, y = 0, width = 1, height = 1, ...) {
polylineGrob(
x=c(x, x+width), y=c(y,y), ..., default.units = "npc",
gp=gpar(lwd=size, col=colour, lty=linetype),
)
},
class = "theme",
type = "box",
call = match.call()
)
}
theme_left_border <- function(colour = "black", size = 1, linetype = 1) {
# use with e.g.: ggplot(...) + opts( panel.border=theme_left_border() ) + ...
structure(
function(x = 0, y = 0, width = 1, height = 1, ...) {
polylineGrob(
x=c(x, x), y=c(y,y+height), ..., default.units = "npc",
gp=gpar(lwd=size, col=colour, lty=linetype),
)
},
class = "theme",
type = "box",
call = match.call()
)
}
theme_border_numerictype <- function(type, colour = "black", size = 1, linetype = 1) {
# use with e.g.: ggplot(...) + opts( panel.border=theme_border(type=9) ) + ...
structure(
function(x = 0, y = 0, width = 1, height = 1, ...) {
# numerical types from: library(gridExtra); example(borderGrob)
# 1=none, 2=bottom, 3=right, 4=top, 5=left, 6=B+R, 7=T+R, 8=T+L, 9=B+L, 10=T+B, 11=L+R, 12=T+B+R, 13=T+L+R, 14=T+B+L, 15=B+L+R, 16=T+B+L+R
xlist <- c()
ylist <- c()
idlist <- c()
if (type==2 || type==6 || type==9 || type==10 || type==12 || type==14 || type==15 || type==16) { # bottom
xlist <- append(xlist, c(x, x+width))
ylist <- append(ylist, c(y, y))
idlist <- append(idlist, c(1,1))
}
if (type==4 || type==7 || type==8 || type==10 || type==12 || type==13 || type==14 || type==16) { # top
xlist <- append(xlist, c(x, x+width))
ylist <- append(ylist, c(y+height, y+height))
idlist <- append(idlist, c(2,2))
}
if (type==5 || type==8 || type==9 || type==11 || type==13 || type==14 || type==15 || type==16) { # left
xlist <- append(xlist, c(x, x))
ylist <- append(ylist, c(y, y+height))
idlist <- append(idlist, c(3,3))
}
if (type==3 || type==6 || type==7 || type==11 || type==12 || type==13 || type==15 || type==16) { # right
xlist <- append(xlist, c(x+width, x+width))
ylist <- append(ylist, c(y, y+height))
idlist <- append(idlist, c(4,4))
}
if (type==1) { # blank; can't pass absence of coordinates, so pass a single point and use an invisible line
xlist <- c(x,x)
ylist <- c(y,y)
idlist <- c(5,5)
linetype <- "blank"
}
polylineGrob(
x=xlist, y=ylist, id=idlist, ..., default.units = "npc",
gp=gpar(lwd=size, col=colour, lty=linetype),
)
},
class = "theme",
type = "box",
call = match.call()
)
}
theme_border <- function(type = c("left", "right", "bottom", "top", "none"), colour = "black", size = 1, linetype = 1) {
# use with e.g.: ggplot(...) + opts( panel.border=theme_border(type=c("bottom","left")) ) + ...
type <- match.arg(type, several.ok=TRUE)
structure(
function(x = 0, y = 0, width = 1, height = 1, ...) {
xlist <- c()
ylist <- c()
idlist <- c()
if ("bottom" %in% type) { # bottom
xlist <- append(xlist, c(x, x+width))
ylist <- append(ylist, c(y, y))
idlist <- append(idlist, c(1,1))
}
if ("top" %in% type) { # top
xlist <- append(xlist, c(x, x+width))
ylist <- append(ylist, c(y+height, y+height))
idlist <- append(idlist, c(2,2))
}
if ("left" %in% type) { # left
xlist <- append(xlist, c(x, x))
ylist <- append(ylist, c(y, y+height))
idlist <- append(idlist, c(3,3))
}
if ("right" %in% type) { # right
xlist <- append(xlist, c(x+width, x+width))
ylist <- append(ylist, c(y, y+height))
idlist <- append(idlist, c(4,4))
}
if (length(type)==0 || "none" %in% type) { # blank; can't pass absence of coordinates, so pass a single point and use an invisible line
xlist <- c(x,x)
ylist <- c(y,y)
idlist <- c(5,5)
linetype <- "blank"
}
polylineGrob(
x=xlist, y=ylist, id=idlist, ..., default.units = "npc",
gp=gpar(lwd=size, col=colour, lty=linetype),
)
},
class = "theme",
type = "box",
call = match.call()
)
}
# Examples:
# library(ggplot2)
# df = data.frame( x=c(1,2,3), y=c(4,5,6) )
# ggplot(data=df, aes(x=x, y=y)) + geom_point() + theme_bw() + opts( panel.border = theme_border_numerictype(9) )
# ggplot(data=df, aes(x=x, y=y)) + geom_point() + theme_bw() + opts( panel.border = theme_border(c("bottom","left")) )
# ----------------------------------------------------------------------------
# Plot and Export Functions
# Sébastien Heymann, April 2012
# ----------------------------------------------------------------------------
DecoratePlot <- function(gplot) {
# Make the plot ready for publication.
if (!require(ggplot2))
stop("Can't load ggplot2.")
theme_set(theme_bw(12))
gplot <- gplot + opts(panel.grid.major = theme_blank())
gplot <- gplot + opts(panel.grid.minor = theme_blank())
gplot <- gplot + opts(panel.border = theme_L_border())
gplot <- gplot + opts(plot.margin = unit(c(0.2,0.4,0,0), "lines")) # delete axis titles: c(0,0,-1,-1)
return(gplot)
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment