Erstellen von ggplot2-Diagrammen, die durch den Plottyp facetwrapped werden

Question

Ich versuche, eine ggplot2-Facette zu erstellen, die vom Plottyp umschlossen ist. Ich habe grid.arrange verwendet, aber ich versuche, den Diagrammbereich zu maximieren, indem ich das grid.arrange benutze, das ich wegen der Wiederholung der y-Achse und der Legenden Bereich verliere.

Insbesondere versuche ich, ein Diagramm zu erstellen, das einen BoxPlot auf der linken Seite mit einer Zeitreihe der gleichen Daten (also derselben Y-Achse) auf der rechten Seite hat. Dann hätte ich eine einzige Y-Achse und eine einzige Legende - ist das möglich?

Der Code:

library(ggplot2) 
library(gridExtra) 
Time = c("19/12/2013 10:00","19/12/2013 10:01", "19/12/2013 10:02", "19/12/2013 10:03", "19/12/2013 10:04", 
    "19/12/2013 10:05", "19/12/2013 10:06", "19/12/2013 10:07", "19/12/2013 10:08", "19/12/2013 10:09", 
    "19/12/2013 10:10", "19/12/2013 10:11", "19/12/2013 10:12", "19/12/2013 10:13", "19/12/2013 10:14") 

test <- data.frame(Time) 

test$Factor <- c("t1", "t1", "t1", "t1", "t1", "t1", "t1", "t1", "t1", "t2", "t2", "t2", "t2", "t2", "t2") 
test$Values <- c(4,7,2,9,6,9,1,1,5,8,3,4,3,6,7) 
test$PROD <- test$PROD <- c("one", "two", "one", "two", "one", "one", "two", "one", "one", 
      "two", "one", "two", "two", "two", "one") 

p1 <-ggplot(data=test,aes(Factor,Values)) + 
    geom_boxplot(outlier.colour = "red", outlier.size = 3, outlier.shape = 15, fill = "white", colour = "blue") + 
    theme(panel.grid.minor = element_line(colour = "grey"), plot.title = element_text(size = rel(2)),axis.text.x = element_text(angle=90, vjust=1), strip.text.x = element_text(size = 8, colour = "black", face = "bold")) + 
    geom_point(alpha = 0.6, position = position_jitter(w = 0.05, h = 0.0), aes(colour=factor(Factor)), size =3) + 
    facet_wrap(~PROD, scales = "free") + 
    ggtitle("MyTitle") + 
    scale_size_area() + 
    xlab("Tools") + 
    ylab("Values") 

p2<-ggplot(data = test, aes(Time,Values)) + 
    ggtitle("MyTitle") + 
    theme(axis.text.x = element_text(angle=90, vjust=1),plot.title = element_text(size = rel(2))) + 
    geom_point(aes(colour=factor(Factor)), size = 3) + 
    facet_wrap(~PROD, scales = "free") + 
    xlab("TIME") + 
    ylab("Values") 

grid.arrange(p1,p2,ncol=2) 

Answer 1

Dies ist keine endgültige Antwort, sollte aber ein guter Anfang sein.

Ich würde

• Format Zeitachse als gültiges Datum Typ
• die x-Achse Etikettendrehung für p1 und p2 entfernen. Wenn Sie die Achsenrotation beibehalten möchten, sollten Sie die Größe des anderen Grob so ändern, dass sie der y-Achse entspricht.
• Remove p1 Legende
• Remove p2 y-Achse Label

Zum Beispiel:

test$Time <- as.POSIXct(test$Time,format='%d/%m/%Y %H:%M') 
## build p1 and p2 using your original code 

grid.arrange(p1+theme(legend.position='none'), 
      p2+theme(axis.title.y=element_blank()), 
      ncol=2) 

EDIT Extrakt Legende grob für mehr Flexibilität:

g_legend<-function(a.gplot){ 
    tmp <- ggplot_gtable(ggplot_build(a.gplot)) 
    leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box") 
    legend <- tmp$grobs[[leg]] 
    legend 
} 
legend1 <- g_legend(p2) 
grid.arrange(p1+theme(legend.position='none'), 
      p2+theme(axis.title.y=element_blank(),legend.position='none'), 
      legend1, 
      ncol=3,nrow=1,widths= c(3/7,3/7,1/7)) 

Answer 2

Sie mit gtable spielen können, aber es gibt ein paar Features fehlen,

library(gtable) 
g1 <- ggplotGrob(p1) 
g2 <- ggplotGrob(p2) 

## drop some elements by name 
## note that trim should check for the sizes if elements still remain 
## in the same column(s)/row(s) of the layout... 
gtable_drop <- function (x, pattern, fixed = FALSE, trim = TRUE) 
{ 
    matches <- grepl(pattern, x$layout$name, fixed = fixed) 
    drop = x$layout[matches, , drop = FALSE] 
    x$layout <- x$layout[!matches, , drop = FALSE] 
    x$grobs <- x$grobs[!matches] 

    if (trim) { 
    x$widths[drop$l] <- replicate(NROW(drop), unit(0,"mm"), simplify=FALSE) 
    x <- gtable_trim(x) 
    } 
    x 
} 

g1p <- gtable_drop(g1, "guide|axis_l-2") 
g2p <- gtable_drop(g2, "axis_l|ylab") 
g <- gtable:::cbind_gtable(g1p, g2p, "last") # ideally "max" but buggy 
grid.newpage() 
grid.draw(g)