Customizing plots within a function (ggplot2) - r

Question

I've written a function that generates a survival plot to my liking using ggplot2. I would like the plot to be customizable, but because I am making a panel of three plots, I can't simply return the plot object to add additional customizations.
I've successfully managed to accomplish what I want using character strings (see the function at the end of the question), but I was wondering if there was a better way to do this; using the character string seems kind of foreign.
For example, the function currently allows me to do this:
require(survival)
fit <- survfit(Surv(time, status) ~ x, data=aml)
ggSurvGraph(fit, times=seq(0, 60, by=12), offset.scale=1, xlim=c(0, 60),
gg_expr="ylab('Percentage Survived') + xlab('Time Elapsed') +
scale_y_continuous(breaks=seq(0, 1.0, by=.25), labels=seq(0, 100, by=25))")
ggexpr gets added to the plot by
if (!missing(gg_expr)) .plot <- eval(parse(text=paste(".plot + ", gg_expr, sep="")))
But it seems to me it would be more natural to pass an expression in gg_expr rather than a character string. Such as this:
require(survival)
fit <- survfit(Surv(time, status) ~ x, data=aml)
ggSurvGraph(fit, times=seq(0, 60, by=12), offset.scale=1, xlim=c(0, 60),
gg_expr=ylab('Percentage Survived') + xlab('Time Elapsed') +
scale_y_continuous(breaks=seq(0, 1.0, by=.25), labels=seq(0, 100, by=25)))
Is there a better way to approach this? (a copy of what the plot looks like follows the function code)
ggSurvGraph <- function(object, times, cum.inc=FALSE, conf.bar=TRUE,
offset.scale=1, n.risk=FALSE, n.event=FALSE,
xlim, gg_expr){
require(stringr)
require(plyr)
require(ggplot2)
require(gridExtra)
require(survival)
#**************************************************************
#*** Parameter checking
error.count <- 0
error.msg <- NULL
#*** 'object' should be either a 'survfit' object or a 'data.frame'
if (!(any(class(object) %in% c("survfit","data.frame")))){
error.count <- error.count + 1
error.msg <- c(error.msg, str_c(error.count, ": \'object\' must be either a survfit object or a data frame", sep=""))
}
#*** When 'object' is a data frame, it must have the columns in 'req.col'
#*** This is a feature that was added so that we could make survival graphs with PROC LIFETEST output
req.col <- c("time","surv","lower","upper","n.risk","n.event")
if ("data.frame" %in% class(object) && !any(req.col %in% names(object))){
miss.col <- str_c("\'", req.col[!req.col %in% names(object)], "\'", sep="", collapse=", ")
error.count <- error.count + 1
error.msg <- c(error.msg, str_c(error.count, ": data frame \'object\' is missing columns ", miss.col, sep=""))
}
#*** Stop the function if any parameter checks failed
if (error.count){
stop(str_c(error.msg, collapse="\n"))
}
#********************************************************************
#*** Prepare the data for plotting
#*** Create data frame from survfit object
if ("survfit" %in% class(object)) survData <- createSurvivalFrame(object) else survData <- object
if (is.null(survData$strata)) survData$strata <- factor(1)
if (cum.inc) survData <- transform(survData,
surv = 1-surv,
lower = 1-lower,
upper = 1-upper)
survData <- ddply(survData,
"strata",
transform,
cum.evt = cumsum(n.event))
#*** Generate offset values
if(nlevels(survData$strata)>1){
offset <- seq.int(-1*ceiling(nlevels(survData$strata)/2),ceiling(nlevels(survData$strata)/2),length.out=nlevels(survData$strata)+1)
offset <- offset[offset!=0]
offset <- offset[order(abs(offset))] * offset.scale
}
else offset <- 0
offset <- data.frame(strata = levels(survData$strata), offset = offset)
survData <- merge(survData, offset, by="strata")
#*************************************************************
#* Limit to 'times' argument
extractSurvTimes <- function(df, reportTime=times){
.out <- df[sapply(reportTime, function(t) max(which(df$time <= t))), ]
.out$reportTime <- reportTime
return(.out)
}
survData <- transform(survData, reportTime = time)
survTimes <- if (missing(times)) survData
else do.call("rbind", lapply(levels(survData$strata), function(x) extractSurvTimes(subset(survData, strata==x))))
if (missing(xlim)) xlim <- c(0, max(survData$time, na.rm=TRUE))
#*************************************************************
#*** Create Plot
#*** Creates a blank plot for a spacer between survival plot and risk/event data
blank.pic <- ggplot(survData, aes(time, surv)) +
geom_blank() + theme_bw() +
theme(axis.text.x = element_blank(), axis.text.y = element_blank(),
axis.title.x = element_blank(), axis.title.y = element_blank(),
axis.ticks = element_blank(),
panel.grid = element_blank(), panel.border = element_blank())
#*** Create the survival plot
if (nlevels(survData$strata) > 1){
.plot <- ggplot(survData, aes(x=time, y=surv, colour=strata)) + geom_step()
}
else{
.plot <- ggplot(survData, aes(x=time, y=surv)) + geom_step()
}
.plot <- .plot + scale_x_continuous(limits = xlim)
#*** Add Confidence bars
if (conf.bar){
.plot <- .plot +
geom_segment(data=survTimes, aes(x=reportTime + offset, xend=reportTime + offset, y=lower, yend=upper))
}
if (!missing(gg_expr)) .plot <- eval(parse(text=paste(".plot + ", gg_expr, sep="")))
riskTable <- survTimes
riskTable <- melt(riskTable[, c("reportTime", "strata", "n.risk", "cum.evt")],
c("reportTime", "strata"))
riskTable <- transform(riskTable,
y.pos = ifelse(variable %in% "n.risk", 1, 0))
.risk <- ggplot(survData, aes(x=time, y=surv)) +
geom_text(data=riskTable, aes(x=reportTime, y=rev(variable), label=value), size=3.5, hjust=0) +
theme_bw() +
# scale_y_discrete(breaks = as.character(levels(riskTable$strata)),
# labels = levels(riskTable$variable)) +
theme(axis.text.x = element_blank(),
axis.title.x = element_blank(), axis.title.y = element_blank(),
axis.ticks = element_blank(),
panel.grid = element_blank(), panel.border = element_blank()) +
scale_x_continuous(limits = xlim) +
scale_y_discrete(labels=c("N Event", "N at Risk"))
if (nlevels(riskTable$strata) > 1) .risk <- .risk + facet_wrap(~ strata, ncol=1)
grid.arrange(.plot + theme(plot.margin = unit(c(1,1,0,.5), "lines"), legend.position="bottom"),
blank.pic + theme(plot.margin = unit(c(0,0,0,0), "lines")),
.risk + theme(plot.margin = unit(c(0,1,0,0), "lines")),
clip = FALSE, nrow = 3,
ncol = 1, heights = unit(c(.70, .04, .35),c("null", "null", "null")))
}

Answer 1

I don't understand your question, but I have a feeling the list() syntax might help,
p = qplot(1:10, 1:10)
p + list(ylab("label"),
scale_x_continuous(),
geom_line())

Answer 2

Abstract
This answer allows you to add ggplot objects to the return value of your function in standard ggplot form. Here, we add coord_cartesian to the first graph of a function that returns two graphs (yours would return a graph and a table, but same idea):
my_plots() + coord_cartesian(ylim=c(0, 5))
Also, note you could add any ggplot object. We just chose coord_cartesian because it was convenient. In your case, you would modify ggSurvGraph to operate like my_plots, which should be pretty simple.
Details
The strategy relies on the function not using grid.arrange, but rather, on having the print method for the object your function returns use grid.arrange. I made up a function that makes a barplot and a scatter plot, but I think it illustrates the point well.
library(gridExtra)
library(ggplot2)
my_plots <- function() {
df <- data.frame(x=1:10, y=(1:10)/10)
gg1 <- ggplot(df) + geom_point(aes(x=x, y=y))
gg2 <- ggplot(df) + geom_bar(aes(x=x, y=y), stat="identity")
structure(list(gg1, gg2), class="myplots")
}
The key here is what I'm returning is a list of the ggplot objects, with a custom class myplots here. Then, I can just define a print method for that class, and have grid.arrange do it's thing:
print.myplots <- function(x, ...) {
do.call(grid.arrange, x)
}
my_plots() outputs the graphs through the print method (note the key point here is that you have two ggplot objects; I realize for yours one of them is a table, but the net result is the same):
my_plots()
And now, I can define a + method, which adds whatever the second operand is to the first value in my list (so in your case, this would only affect the graph, not the table):
`+.myplots` <- function(e1, e2) {
e1[[1]] <- e1[[1]] + e2
invisible(e1)
}
Now, we can use as illustrated in the abstract (notice how the Y axis changed for the first graph):
my_plots() + coord_cartesian(ylim=c(0, 5))