Idealne dopasowanie wykresu ggplot2 na wykresie

Question

Chcę wykreślić ograniczony splajn sześcienny jako główną działkę i dodać wykres bok-i-wąs, aby pokazać odmianę zmiennej X. Jednak dolny zawias (x = 42), mediana (x = 51) i górny zawias (x = 61) nie pasowały idealnie do odpowiadającej linii siatki głównego wykresu.

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. Co muszę zmienić na idealne dopasowanie?
2. Czy jest lepiej zautomatyzowane wyrównanie pozycji y boksu i wąsika ?

Aktualizacja # 1 Dzięki za odpowiedź! Poniżej możesz zobaczyć mój przykład z Twoim kodem. Jednak, jak widać, dolny zawias, środkowa część i górny zawias nadal nie pasują. Co idzie źle?

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)) 

Answer 1

Minor edit: Aktualizacja do ggplot2 2.0.0 axis.ticks.margin jest przestarzała

W boxplot, nawet jeśli zostały ustawione różne elementy do element_blank i marże do zera, domyślnie pozostały spacje powodujące niewspółosiowość. Przestrzenie te należą do:

• axis.ticks.length
• xlab

W poniższym kodzie, mam ponownie umieszczony kod nieco (mam nadzieję, że jest w porządku), a wykomentowane niektóre linie kodu, aby można było zobaczyć, że te dwie strony są wyrównane. Ustawiłem również przerwy na dwóch polach na niezaokrąglone breaks (wartości minimalne i maksymalne, zawiasy i mediana).

# 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)) 

Należy pamiętać, metodę, która ggplot dla obliczania zawiasy nieznacznie różni się od metody zastosowanej przez 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] 

Answer 2

odpowiedź Alternatywne użyciu gtable funkcji na pozycję Wykres pudełkowy zewnątrz głównego wątku. Wysokość działki skrzynki może być regulowana za pomocą parametru „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)