I am receiving an error from a program including ggplot, grid, and gridExtra that appears to be similar to a bunch of issues listed in github that appear to be known bugs in the tidyverse/ggplot/grid area. (See: Release ggplot2 3.1.1 · Issue #3207 · tidyverse/ggplot2 · GitHub
The following is the code for my function, then the code to produce the reprex. (Sorry for the length. I tried to upload an R save file, but that seems not to be allowed.)
The program:
# Create a Kaplan-Meier plot with optional risktable, using ggplot2
#
# param sfit: a survfit object
# param table: logical: If TRUE,create an at-risk table below
# the K-M plot, Default = TRUE. Else no at-risk table drawn.
# param printPlot: logical: if T a ggplot is made.
# If F, no plot is made. Default = TRUE.
# param cols: plot colors, Default = 1:10
# param ltypes: plot line types, Default = 1:10
# param lnwd: plot line width, Default = 1
# param timeby: integer: period of x-axis markers, Default = 100
# param xlabs: x-axis label, Default = "Time"
# param ylabs: y-axis label. Default = "survival probability"
# param title: Default = NULL
# param txtsize: plot text size in points, Default = 11 pt.
# param y_lim: y-axis limit. Default = c(0, 1)
# param stratanames: Default names(sfit$strata)
# param LegendTitle: Default = "Strata"?
# param legendposition: "left","top", "right", "bottom", "none",
# or fraction of x and y axes: e.g. c(.28,.35). Default = "right"l
# param pval: logical: add pvalue to the plot: Default = TRUE
# param pval_location as fraction of x and y axes.
# Default = c(0.6, 0.1)
## param margins: margins for KM plot -- may be needed to align
## with table. Default: unit(c(0.5, 1, 0.5, 2.5), "lines")
# param tbltxtsz: Relative table text size. Default = 1
# (May be needed if at risk figures overlap.)
# author: L. G. Hunsicker, refactored from Abhijit Dasgupta
# with contributions by Gil Tomas
LHggkmTablea <- function(sfit, table=TRUE, printPlot = TRUE,
xlabs = "Time", ylabs = "survival probability", timeby = 100,
LegendTitle = "Strata", legendposition = "top", txtsize = 11,
cols = 1:10, ltypes = 1:10, y_lim = c(0,1), lnwd = 1,
pval = TRUE, pval_location = c(0.6, 0.1), title = NULL,
# margins = unit(c(2, 2, 2, 2), "lines"),
stratanames = NULL, tbltxtsz = 1, ...)
{
require(survival)
require(ggplot2)
require(plyr)
require(broom)
require(gridExtra)
times <- seq(0, max(sfit$time), by = timeby)
StrataNames <- names(sfit$strata)
StrataOrder <- factor(StrataNames, levels = StrataNames)
.df <- tidy(sfit)[, c(1:2, 5, 9)]
.df$strata <- factor(.df$strata, levels = StrataOrder)
zeros <- data.frame(time = 0, estimate = 1, strata = StrataOrder)
.df <- rbind.fill(zeros, .df)
if (is.null(stratanames)) stratanames<-gsub("^[^=]*=", "",
StrataNames)
d <- length(levels(.df$strata))
.df$strata <- mapvalues(.df$strata, from = levels(.df$strata),
to = stratanames)
p <- ggplot(.df, aes(time, estimate, group = strata)) +
geom_step(aes(linetype = strata, col = strata), size = lnwd) +
theme_bw() +
theme(text = element_text(size = txtsize)) +
theme(axis.title.x = element_text(vjust = 0.5)) +
scale_x_continuous(xlabs, breaks = times,
limits = c(0, max(sfit$time))) +
scale_y_continuous(ylabs, limits = y_lim) +
scale_color_manual(name = LegendTitle,values = cols) +
scale_linetype_manual(name = LegendTitle,values = ltypes) +
theme(panel.grid.minor = element_blank()) +
theme(legend.position = legendposition) +
theme(legend.key = element_rect(colour = NA)) +
theme(legend.key.width=unit(3,"line")) +
theme(legend.key.height = unit(1, "line")) +
theme(axis.text = element_text(face = 'bold')) +
ggtitle(title)
if(pval) {
sdiff <- survdiff(eval(sfit$call$formula),
data = eval(sfit$call$data))
pval <- pchisq(sdiff$chisq, length(sdiff$n)-1,
lower.tail = FALSE)
pvaltxt <- ifelse(pval < 0.0001, "p < 0.0001",
paste("p =", signif(pval, 3)))
p <- p + annotate("text", size = txtsize/.pt,
x = pval_location[1] * max(sfit$time),
y = pval_location[2], label = pvaltxt)
}
if(table) {
## Create table graphic to include at-risk numbers
# Generate at.risk table.
at.risk <- summary(fit1, extend = T, times = times)
at.risk <- with(at.risk, data.frame(time1 = time,
atrisk = n.risk, strata = strata))
# Plot table
data.table <- ggplot(at.risk, aes(x = time1, y = strata))+
geom_text(label = format(at.risk$atrisk, nsmall = 0),
size = txtsize * tbltxtsz/.pt) +
theme_bw() +
scale_x_continuous("Numbers at risk", breaks = times,
limits = c(0, max(sfit$time))) +
theme(axis.title.x = element_text(size = 10, vjust = 1),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
axis.ticks.x = element_blank(),
axis.text.x = element_blank()) +
ylab(NULL)
# Arrange plot and table in single grob.
p1 <- ggplot_gtable(ggplot_build(p))
data.table1 <- ggplot_gtable(ggplot_build(data.table))
p1$widths <- data.table1$widths
p <- arrangeGrob(p1, data.table1, nrow = 2, ncol = 1,
heights = unit(c(1, d* 0.08) ,c("null", "null")))
}
if (printPlot) plot(p)
return(invisible(p))
}
Creating the mock data and the call that abends:
data1 <- data.frame(status = sample(0:1, 50, replace = T), sex = sample(0:1, 50, replace = T))
data1 %<>% mutate(time1 = ifelse(status == 1, rnorm(50, 5,2), .2*rnorm(50,5,2)),
time1 = ifelse(sex == 1, time1 + 5, time1))
data1$time1 <- with(data1, ifelse(time1 <=0, 0.1, time1))
data1$time <- with(data1, ifelse(sex == 1, time1 + 2, time1))
summary(data1)
data1 %>% group_by(sex) %>% summarise(mntime = mean(time1))
data1 %>% group_by(status) %>% summarise(mntime = mean(time1))
fit1 <- survfit(Surv(time1, status) ~ sex, data = data1)
plot6 <- LHggkmTablea(fit1, table = T, timeby = 5, xlab = 'Years', pval_location = c(.2,.2), legendposition = 'left')
The specific issue is that when I run a home brewed version of LHggkmTablea, including the table, and placing the legend at either the right or the left, I get the following error.
Error in grid.Call.graphics(C_setviewport, vp, TRUE) :
invalid 'layout.pos.col'
This program runs correctly when I set the legendlocation to "top", "bottom", "none", or when I specify a location within the plot. It also runs correctly when I set table to F with any of the legend locations. I ran all these trials under R version 4.1.2, ggplot2 3.3.5, grid 4.1.2, and gridExtra 2.3, all in RStudio 2021.09.0 Build 351, and all on a Windows 10, 64 bit workstation, fully updated. I got exactly the same on my Ubuntu 20.4 LT box, so it is not a Windows vs. Linux issue.
The traceback() is virtually identical to that in R-devel: Error in grid.Call.graphics(C_setviewport, vp, TRUE) : VECTOR_ELT() can only be applied to a 'list', not a 'double' · Issue #3217 · tidyverse/ggplot2 · GitHub, which also references Issue #3215
> traceback()
25: grid.Call.graphics(C_setviewport, vp, TRUE)
24: push.vp.viewport(X[[i]], ...)
23: FUN(X[[i]], ...)
22: lapply(vps, push.vp, recording)
21: pushViewport(vp, recording = FALSE)
20: pushgrobvp.viewport(x$vp)
19: pushgrobvp(x$vp)
18: pushvpgp(x)
17: preDraw.grob(x)
16: preDraw(x)
15: drawGrob(x)
14: recordGraphics(drawGrob(x), list(x = x), getNamespace("grid"))
13: grid.draw.grob(x$children[[i]], recording = FALSE)
12: grid.draw(x$children[[i]], recording = FALSE)
11: drawGTree(x)
10: recordGraphics(drawGTree(x), list(x = x), getNamespace("grid"))
9: grid.draw.gTree(x$children[[i]], recording = FALSE)
8: grid.draw(x$children[[i]], recording = FALSE)
7: drawGTree(x)
6: recordGraphics(drawGTree(x), list(x = x), getNamespace("grid"))
5: grid.draw.gTree(x)
4: grid.draw(x)
3: plot.gtable(p)
2: plot(p) at ggkmTableLGH1a.r#115
1: LHggkmTablea(fit1, table = T, timeby = 5, xlab = "Years", pval_location = c(0.2,
0.2), legendposition = "left")
Again, I apologize for the long post. I tried to create a posting on the github tidyverse/ggplot2 site, but I couldn't figure out how to submit it there, despite my having a github account. If it would be more appropriate to submit the report there, I'd be glad to do it if someone would tell me how to get posting permission.
Many thanks for any help with this.
Larry Hunsicker