ggplot2情节在情节中的完美契合
Perfect fit of ggplot2 plot in plot
我想绘制一个受限三次样条作为主图,并添加一个盒须图来显示 X 变量的变化。然而,下铰链(x=42)、中铰链(x=51)和上铰链(x=61)与主图对应的网格线并不完全吻合。
library(Hmisc)
library(rms)
library(ggplot2)
library(gridExtra)
data(pbc)
d <- pbc
rm(pbc)
d$status <- ifelse(d$status != 0, 1, 0)
dd = datadist(d)
options(datadist='dd')
f <- cph(Surv(time, status) ~ rcs(age, 4), data=d)
p <- Predict(f, fun=exp)
df <- data.frame(age=p$age, yhat=p$yhat, lower=p$lower, upper=p$upper)
### 1st PLOT: main plot
(g <- ggplot(data=df, aes(x=age, y=yhat)) + geom_line(size=1))
# CI
(g <- g + geom_ribbon(data=df, aes(ymin=lower, ymax=upper), alpha=0.5, linetype=0, fill='#FFC000'))
# white background
(g <- g + theme_bw())
# X-axis
(breaks <- round(boxplot.stats(p[,"age"])$stats))
(g <- g + scale_x_continuous(breaks=breaks, limits=range(p[,"age"]), labels=round(breaks)))
(g <- g + xlab("Age"))
# Y-Achse
(g <- g + ylab("Hazard Ratio"))
# size and color of axis
(g <- g + theme(axis.line = element_line(color='black', size=1)))
(g <- g + theme(axis.ticks = element_line(color='black', size=1)))
(g <- g + theme( plot.background = element_blank() ))
#(g <- g + theme( panel.grid.major = element_blank() ))
(g <- g + theme( panel.grid.minor = element_blank() ))
(g <- g + theme( panel.border = element_blank() ))
### 2nd PLOT: box whisker plot
describe(df$age, digits=0)
round(range(df$age))
(gg <- ggplot(data=df, aes(x=1, y=age)) + geom_boxplot(outlier.shape=NA, size=1) + coord_flip())
(gg <- gg + theme( axis.line=element_blank() )) #
(gg <- gg + theme( axis.text.x=element_blank() ))
(gg <- gg + theme( axis.text.y=element_blank() ))
(gg <- gg + theme( axis.ticks=element_blank() ))
(gg <- gg + theme( axis.title.x=element_blank() ))
(gg <- gg + theme( axis.title.y=element_blank() ))
(gg <- gg + theme( panel.background=element_blank() ))
(gg <- gg + theme( panel.border=element_blank() )) #
(gg <- gg + theme( legend.position="none" )) #
(gg <- gg + theme( panel.grid.major=element_blank() )) #
(gg <- gg + theme( panel.grid.minor=element_blank() ))
(gg <- gg + theme( plot.background=element_blank() ))
(gg <- gg + theme( plot.margin = unit( c(0,0,0,0), "in" ) ))
(gg <- gg + scale_x_continuous(breaks=c(70,77,84), expand=c(0,0)) )
### FINAL PLOT: put box whisker plot in main plot
(final.gg <- g + annotation_custom(ggplotGrob(gg), ymin=2.4, ymax=2.6))
- 我需要改变什么才能完美贴合?
- 有没有更好的自动对齐的y轴位置
盒须?
更新 #1
感谢您的回答!下面你可以看到我的例子和你的代码。但是,如您所见,下铰链、中间铰链和上铰链仍然不适合。出了什么问题?
library(Hmisc)
library(rms)
library(ggplot2)
library(gridExtra)
data(pbc)
d <- pbc
rm(pbc, pbcseq)
d$status <- ifelse(d$status != 0, 1, 0)
dd = datadist(d)
options(datadist='dd')
f <- cph(Surv(time, status) ~ rcs(age, 4), data=d)
p <- Predict(f, fun=exp)
df <- data.frame(age=p$age, yhat=p$yhat, lower=p$lower, upper=p$upper)
### 1st PLOT: main plot
(breaks <- boxplot.stats(p[,"age"])$stats)
g <- ggplot(data=df, aes(x=age, y=yhat)) + geom_line(size=1) +
geom_ribbon(data=df, aes(ymin=lower, ymax=upper), alpha=0.5, linetype=0, fill='#FFC000') +
theme_bw() +
scale_x_continuous(breaks=breaks) +
xlab("Age") +
ylab("Hazard Ratio") +
theme(axis.line = element_line(color='black', size=1),
axis.ticks = element_line(color='black', size=1),
plot.background = element_blank(),
# panel.border = element_blank(),
panel.grid.minor = element_blank())
### 2nd PLOT: box whisker plot
gg <- ggplot(data=df, aes(x=1, y=age)) +
geom_boxplot(outlier.shape=NA, size=1) +
scale_y_continuous(breaks=breaks) +
ylab(NULL) +
coord_flip() +
# theme_bw() +
theme(axis.line=element_blank(),
# axis.text.x=element_blank(),
axis.text.y=element_blank(),
axis.ticks.y=element_blank(),
axis.title=element_blank(),
# panel.background=element_blank(),
panel.border=element_blank(),
# panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
# plot.background=element_blank(),
plot.margin = unit( c(0,0,0,0), "in" ),
axis.ticks.margin = unit(0, "lines"),
axis.ticks.length = unit(0, "cm"))
### FINAL PLOT: put box whisker plot in main plot
(final.gg <- g + annotation_custom(ggplotGrob(gg), ymin=2.4, ymax=2.6))
小修改:更新到 ggplot2 2.0.0
axis.ticks.margin
已弃用
在箱线图中,即使您已将各种元素设置为 element_blank
并将边距设置为零,默认空间仍然会导致未对齐。这些空间属于:
- axis.ticks.length
- xlab
在下面的代码中,我稍微重新安排了您的代码(希望没关系),并注释掉了一些代码行,以便可以看出这两个图确实对齐了。我还将两个图中的中断设置为未舍入 breaks
(最小值和最大值、铰链和中值)。
# X-axis
(breaks <- boxplot.stats(p[,"age"])$stats)
### 1st PLOT: main plot
g <- ggplot(data=df, aes(x=age, y=yhat)) + geom_line(size=1) +
geom_ribbon(data=df, aes(ymin=lower, ymax=upper), alpha=0.5, linetype=0, fill='#FFC000') +
theme_bw() +
scale_x_continuous(breaks=breaks) +
xlab("Age") +
ylab("Hazard Ratio") +
theme(axis.line = element_line(color='black', size=1),
axis.ticks = element_line(color='black', size=1),
plot.background = element_blank(),
# panel.border = element_blank(),
panel.grid.minor = element_blank())
### 2nd PLOT: box whisker plot
gg <- ggplot(data=df, aes(x=1, y=age)) +
geom_boxplot(outlier.shape=NA, size=1) +
scale_y_continuous(breaks=breaks) +
xlab(NULL) +
coord_flip() +
# theme_bw() +
theme(axis.line=element_blank(),
# axis.text.x=element_blank(),
axis.text.y=element_blank(),
axis.ticks.y=element_blank(),
axis.title=element_blank(),
# panel.background=element_blank(),
panel.border=element_blank(),
# panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
# plot.background=element_blank(),
plot.margin = unit( c(0,0,0,0), "in" ),
# axis.ticks.margin = unit(0, "lines"),
axis.ticks.length = unit(0, "cm"))
### FINAL PLOT: put box whisker plot in main plot
(final.gg <- g + annotation_custom(ggplotGrob(gg), ymin=2.4, ymax=2.6))
您应该注意到 ggplot 计算铰链的方法与 boxplot.stats
使用的方法略有不同。
# ggplot's hinges
bp = ggplot(data=df, aes(x=1, y=age)) +
geom_boxplot(outlier.shape=NA, size=1)
bpData = ggplot_build(bp)
bpData$data[[1]][1:5]
替代答案使用 gtable
函数将箱线图定位在主图之外。可以使用 "h" 参数
调整箱线图的高度
library(rms)
# Data
data(pbc)
d <- pbc
rm(pbc)
d$status <- ifelse(d$status != 0, 1, 0)
dd = datadist(d)
options(datadist='dd')
f <- cph(Surv(time, status) ~ rcs(age, 4), data=d)
p <- Predict(f, fun=exp)
df <- data.frame(age=p$age, yhat=p$yhat, lower=p$lower, upper=p$upper)
# X-axis
breaks <- boxplot.stats(p[,"age"])$stats
# Main plot
MP <- ggplot(data=df, aes(x=age, y=yhat)) + geom_line(size=1) +
geom_ribbon(data=df, aes(ymin=lower, ymax=upper), alpha=0.5, linetype=0, fill='#FFC000') +
theme_bw() +
scale_x_continuous(breaks=breaks) +
xlab("Age") +
ylab("Hazard Ratio") +
theme(axis.line = element_line(color='black', size=1),
axis.ticks = element_line(color='black', size=1),
panel.grid.minor = element_blank())
# Boxplot
BP <- ggplot(data=df, aes(x=factor(1), y=age)) +
geom_boxplot(width = 1, outlier.shape=NA, size=1) +
geom_jitter(position = position_jitter(width = .3), size = 1) +
scale_y_continuous(breaks=breaks) +
coord_flip() +
theme_bw() +
theme(panel.border=element_blank(),
panel.grid=element_blank())
#### Set up the grobs and gtables here
library(gtable)
library(grid)
h = 1/15 # height of boxplot panel relative to main plot panel
# Get ggplot grobs
gMP = ggplotGrob(MP)
BPg = ggplotGrob(BP)
BPg = gtable_filter(BPg, "panel") # from the boxplot, extract the panel only
# In the main plot, get position of panel in the layout
pos = gMP$layout[gMP$layout$name == "panel", c('t', 'l')]
# In main plot, set height for boxplot
gMP$heights[pos$t-2] = unit(h, "null")
# Add boxplot to main plot
gMP = gtable_add_grob(gMP, BPg, t=pos$t-2, l=pos$l)
# Add small space
gMP$heights[pos$t-1] = unit(5, "pt")
# Draw it
grid.newpage()
grid.draw(gMP)
我想绘制一个受限三次样条作为主图,并添加一个盒须图来显示 X 变量的变化。然而,下铰链(x=42)、中铰链(x=51)和上铰链(x=61)与主图对应的网格线并不完全吻合。
library(Hmisc)
library(rms)
library(ggplot2)
library(gridExtra)
data(pbc)
d <- pbc
rm(pbc)
d$status <- ifelse(d$status != 0, 1, 0)
dd = datadist(d)
options(datadist='dd')
f <- cph(Surv(time, status) ~ rcs(age, 4), data=d)
p <- Predict(f, fun=exp)
df <- data.frame(age=p$age, yhat=p$yhat, lower=p$lower, upper=p$upper)
### 1st PLOT: main plot
(g <- ggplot(data=df, aes(x=age, y=yhat)) + geom_line(size=1))
# CI
(g <- g + geom_ribbon(data=df, aes(ymin=lower, ymax=upper), alpha=0.5, linetype=0, fill='#FFC000'))
# white background
(g <- g + theme_bw())
# X-axis
(breaks <- round(boxplot.stats(p[,"age"])$stats))
(g <- g + scale_x_continuous(breaks=breaks, limits=range(p[,"age"]), labels=round(breaks)))
(g <- g + xlab("Age"))
# Y-Achse
(g <- g + ylab("Hazard Ratio"))
# size and color of axis
(g <- g + theme(axis.line = element_line(color='black', size=1)))
(g <- g + theme(axis.ticks = element_line(color='black', size=1)))
(g <- g + theme( plot.background = element_blank() ))
#(g <- g + theme( panel.grid.major = element_blank() ))
(g <- g + theme( panel.grid.minor = element_blank() ))
(g <- g + theme( panel.border = element_blank() ))
### 2nd PLOT: box whisker plot
describe(df$age, digits=0)
round(range(df$age))
(gg <- ggplot(data=df, aes(x=1, y=age)) + geom_boxplot(outlier.shape=NA, size=1) + coord_flip())
(gg <- gg + theme( axis.line=element_blank() )) #
(gg <- gg + theme( axis.text.x=element_blank() ))
(gg <- gg + theme( axis.text.y=element_blank() ))
(gg <- gg + theme( axis.ticks=element_blank() ))
(gg <- gg + theme( axis.title.x=element_blank() ))
(gg <- gg + theme( axis.title.y=element_blank() ))
(gg <- gg + theme( panel.background=element_blank() ))
(gg <- gg + theme( panel.border=element_blank() )) #
(gg <- gg + theme( legend.position="none" )) #
(gg <- gg + theme( panel.grid.major=element_blank() )) #
(gg <- gg + theme( panel.grid.minor=element_blank() ))
(gg <- gg + theme( plot.background=element_blank() ))
(gg <- gg + theme( plot.margin = unit( c(0,0,0,0), "in" ) ))
(gg <- gg + scale_x_continuous(breaks=c(70,77,84), expand=c(0,0)) )
### FINAL PLOT: put box whisker plot in main plot
(final.gg <- g + annotation_custom(ggplotGrob(gg), ymin=2.4, ymax=2.6))
- 我需要改变什么才能完美贴合?
- 有没有更好的自动对齐的y轴位置 盒须?
更新 #1 感谢您的回答!下面你可以看到我的例子和你的代码。但是,如您所见,下铰链、中间铰链和上铰链仍然不适合。出了什么问题?
library(Hmisc)
library(rms)
library(ggplot2)
library(gridExtra)
data(pbc)
d <- pbc
rm(pbc, pbcseq)
d$status <- ifelse(d$status != 0, 1, 0)
dd = datadist(d)
options(datadist='dd')
f <- cph(Surv(time, status) ~ rcs(age, 4), data=d)
p <- Predict(f, fun=exp)
df <- data.frame(age=p$age, yhat=p$yhat, lower=p$lower, upper=p$upper)
### 1st PLOT: main plot
(breaks <- boxplot.stats(p[,"age"])$stats)
g <- ggplot(data=df, aes(x=age, y=yhat)) + geom_line(size=1) +
geom_ribbon(data=df, aes(ymin=lower, ymax=upper), alpha=0.5, linetype=0, fill='#FFC000') +
theme_bw() +
scale_x_continuous(breaks=breaks) +
xlab("Age") +
ylab("Hazard Ratio") +
theme(axis.line = element_line(color='black', size=1),
axis.ticks = element_line(color='black', size=1),
plot.background = element_blank(),
# panel.border = element_blank(),
panel.grid.minor = element_blank())
### 2nd PLOT: box whisker plot
gg <- ggplot(data=df, aes(x=1, y=age)) +
geom_boxplot(outlier.shape=NA, size=1) +
scale_y_continuous(breaks=breaks) +
ylab(NULL) +
coord_flip() +
# theme_bw() +
theme(axis.line=element_blank(),
# axis.text.x=element_blank(),
axis.text.y=element_blank(),
axis.ticks.y=element_blank(),
axis.title=element_blank(),
# panel.background=element_blank(),
panel.border=element_blank(),
# panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
# plot.background=element_blank(),
plot.margin = unit( c(0,0,0,0), "in" ),
axis.ticks.margin = unit(0, "lines"),
axis.ticks.length = unit(0, "cm"))
### FINAL PLOT: put box whisker plot in main plot
(final.gg <- g + annotation_custom(ggplotGrob(gg), ymin=2.4, ymax=2.6))
小修改:更新到 ggplot2 2.0.0
axis.ticks.margin
已弃用
在箱线图中,即使您已将各种元素设置为 element_blank
并将边距设置为零,默认空间仍然会导致未对齐。这些空间属于:
- axis.ticks.length
- xlab
在下面的代码中,我稍微重新安排了您的代码(希望没关系),并注释掉了一些代码行,以便可以看出这两个图确实对齐了。我还将两个图中的中断设置为未舍入 breaks
(最小值和最大值、铰链和中值)。
# X-axis
(breaks <- boxplot.stats(p[,"age"])$stats)
### 1st PLOT: main plot
g <- ggplot(data=df, aes(x=age, y=yhat)) + geom_line(size=1) +
geom_ribbon(data=df, aes(ymin=lower, ymax=upper), alpha=0.5, linetype=0, fill='#FFC000') +
theme_bw() +
scale_x_continuous(breaks=breaks) +
xlab("Age") +
ylab("Hazard Ratio") +
theme(axis.line = element_line(color='black', size=1),
axis.ticks = element_line(color='black', size=1),
plot.background = element_blank(),
# panel.border = element_blank(),
panel.grid.minor = element_blank())
### 2nd PLOT: box whisker plot
gg <- ggplot(data=df, aes(x=1, y=age)) +
geom_boxplot(outlier.shape=NA, size=1) +
scale_y_continuous(breaks=breaks) +
xlab(NULL) +
coord_flip() +
# theme_bw() +
theme(axis.line=element_blank(),
# axis.text.x=element_blank(),
axis.text.y=element_blank(),
axis.ticks.y=element_blank(),
axis.title=element_blank(),
# panel.background=element_blank(),
panel.border=element_blank(),
# panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
# plot.background=element_blank(),
plot.margin = unit( c(0,0,0,0), "in" ),
# axis.ticks.margin = unit(0, "lines"),
axis.ticks.length = unit(0, "cm"))
### FINAL PLOT: put box whisker plot in main plot
(final.gg <- g + annotation_custom(ggplotGrob(gg), ymin=2.4, ymax=2.6))
您应该注意到 ggplot 计算铰链的方法与 boxplot.stats
使用的方法略有不同。
# ggplot's hinges
bp = ggplot(data=df, aes(x=1, y=age)) +
geom_boxplot(outlier.shape=NA, size=1)
bpData = ggplot_build(bp)
bpData$data[[1]][1:5]
替代答案使用 gtable
函数将箱线图定位在主图之外。可以使用 "h" 参数
library(rms)
# Data
data(pbc)
d <- pbc
rm(pbc)
d$status <- ifelse(d$status != 0, 1, 0)
dd = datadist(d)
options(datadist='dd')
f <- cph(Surv(time, status) ~ rcs(age, 4), data=d)
p <- Predict(f, fun=exp)
df <- data.frame(age=p$age, yhat=p$yhat, lower=p$lower, upper=p$upper)
# X-axis
breaks <- boxplot.stats(p[,"age"])$stats
# Main plot
MP <- ggplot(data=df, aes(x=age, y=yhat)) + geom_line(size=1) +
geom_ribbon(data=df, aes(ymin=lower, ymax=upper), alpha=0.5, linetype=0, fill='#FFC000') +
theme_bw() +
scale_x_continuous(breaks=breaks) +
xlab("Age") +
ylab("Hazard Ratio") +
theme(axis.line = element_line(color='black', size=1),
axis.ticks = element_line(color='black', size=1),
panel.grid.minor = element_blank())
# Boxplot
BP <- ggplot(data=df, aes(x=factor(1), y=age)) +
geom_boxplot(width = 1, outlier.shape=NA, size=1) +
geom_jitter(position = position_jitter(width = .3), size = 1) +
scale_y_continuous(breaks=breaks) +
coord_flip() +
theme_bw() +
theme(panel.border=element_blank(),
panel.grid=element_blank())
#### Set up the grobs and gtables here
library(gtable)
library(grid)
h = 1/15 # height of boxplot panel relative to main plot panel
# Get ggplot grobs
gMP = ggplotGrob(MP)
BPg = ggplotGrob(BP)
BPg = gtable_filter(BPg, "panel") # from the boxplot, extract the panel only
# In the main plot, get position of panel in the layout
pos = gMP$layout[gMP$layout$name == "panel", c('t', 'l')]
# In main plot, set height for boxplot
gMP$heights[pos$t-2] = unit(h, "null")
# Add boxplot to main plot
gMP = gtable_add_grob(gMP, BPg, t=pos$t-2, l=pos$l)
# Add small space
gMP$heights[pos$t-1] = unit(5, "pt")
# Draw it
grid.newpage()
grid.draw(gMP)