Идеально вписывается в ggplot2 сюжет

Я хочу построить ограниченный кубический сплайн в качестве основного графика и добавить график типа "квадрат и усы", чтобы показать изменение переменной X. Однако нижний шарнир (х =42), медиана (х =51) и верхний шарнир (х =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))
  1. Что я должен изменить для идеальной подгонки?
  2. Есть ли лучшее для автоматизированного выравнивания 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))

Источник

2 ответа

Решение

Небольшое редактирование: обновление до ggplot2 2.0.0axis.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)

Источник
Другие вопросы по тегам