za pomocą siatki i ggplot2, aby utworzyć wykresy łączenia za pomocą R

Question

Chciałbym wiedzieć, co mogę zrobić, aby naprawić siatkę działek. Wykresy są rozmieszczone w układzie tak, że wszystkie wykresy w rzędzie mają tę samą zmienną osi Y, a wszystkie wykresy w kolumnie mają tę samą zmienną osi X.

Po połączeniu w siatkę tworzy multiplot. Wyłączam etykiety na większości działek, z wyjątkiem tych zewnętrznych, ponieważ te wewnętrzne mają tę samą zmienną i skalę. Ponieważ jednak zewnętrzne wykresy mają etykiety i wartości osi, mają one inną wielkość niż pozostałe.

Zastanawiam się nad dodaniem 2 kolejnych kolumn i wierszy do siatki, nazw zmiennych i wartości zakresu osi ... a następnie naniesienia tylko nazw zmiennych w odpowiednim obszarze siatki i wartości osi na innym obszarze siatki, dlatego tylko wykreśla punkty w pozostałej przestrzeni i otrzymuje równe rozmiary.

EDIT 1: Dzięki RCS za wskazanie mi kierunku align.plot

redakcją align.plot zaakceptować wartości null (do kiedy posiadające tytuł/tekst w isnt osi pożądanej)

Teraz jestem bliżej do celu, ale pierwsze wykresy columun są wciąż mniejsze niż reszta ze względu na etykiety.

przykładowy kod:

grid_test <- function() 
{ 
    dsmall <- diamonds[sample(nrow(diamonds), 100), ] 

    #-----/align function----- 
    align.plots <- function(gl, ...){ 
     # Obtained from http://groups.google.com/group/ggplot2/browse_thread/thread/1b859d6b4b441c90 
     # Adopted from http://ggextra.googlecode.com/svn/trunk/R/align.r 

     # BUGBUG: Does not align horizontally when one has a title. 
     # There seems to be a spacer used when a title is present. Include the 
     # size of the spacer. Not sure how to do this yet. 

     stats.row <- vector("list", gl$nrow) 
     stats.col <- vector("list", gl$ncol) 

     lstAll <- list(...) 

     dots <- lapply(lstAll, function(.g) ggplotGrob(.g[[1]])) 
     #ytitles <- lapply(dots, function(.g) editGrob(getGrob(.g,"axis.title.y.text",grep=TRUE), vp=NULL)) 
     #ylabels <- lapply(dots, function(.g) editGrob(getGrob(.g,"axis.text.y.text",grep=TRUE), vp=NULL)) 
     #xtitles <- lapply(dots, function(.g) editGrob(getGrob(.g,"axis.title.x.text",grep=TRUE), vp=NULL)) 
     #xlabels <- lapply(dots, function(.g) editGrob(getGrob(.g,"axis.text.x.text",grep=TRUE), vp=NULL)) 
     plottitles <- lapply(dots, function(.g) editGrob(getGrob(.g,"plot.title.text",grep=TRUE), vp=NULL)) 

     xtitles <- lapply(dots, function(.g) if(!is.null(getGrob(.g,"axis.title.x.text",grep=TRUE))) 
         editGrob(getGrob(.g,"axis.title.x.text",grep=TRUE), vp=NULL) else ggplot2:::.zeroGrob) 

     xlabels <- lapply(dots, function(.g) if(!is.null(getGrob(.g,"axis.text.x.text",grep=TRUE))) 
         editGrob(getGrob(.g,"axis.text.x.text",grep=TRUE), vp=NULL) else ggplot2:::.zeroGrob) 

     ytitles <- lapply(dots, function(.g) if(!is.null(getGrob(.g,"axis.title.y.text",grep=TRUE))) 
         editGrob(getGrob(.g,"axis.title.y.text",grep=TRUE), vp=NULL) else ggplot2:::.zeroGrob) 

     ylabels <- lapply(dots, function(.g) if(!is.null(getGrob(.g,"axis.text.y.text",grep=TRUE))) 
         editGrob(getGrob(.g,"axis.text.y.text",grep=TRUE), vp=NULL) else ggplot2:::.zeroGrob) 

     legends <- lapply(dots, function(.g) if(!is.null(.g$children$legends)) 
         editGrob(.g$children$legends, vp=NULL) else ggplot2:::.zeroGrob) 

     widths.left <- mapply(`+`, e1=lapply(ytitles, grobWidth), 
          e2= lapply(ylabels, grobWidth), SIMPLIFY=FALSE) 
     widths.right <- lapply(legends, grobWidth) 
     # heights.top <- lapply(plottitles, grobHeight) 
     heights.top <- lapply(plottitles, function(x) unit(0,"cm")) 
     heights.bottom <- mapply(`+`, e1=lapply(xtitles, grobHeight), e2= lapply(xlabels, grobHeight), SIMPLIFY=FALSE) 

     for (i in seq_along(lstAll)) { 
      lstCur <- lstAll[[i]] 

      # Left 
      valNew <- widths.left[[ i ]] 
      valOld <- stats.col[[ min(lstCur[[3]]) ]]$widths.left.max 
      if (is.null(valOld)) valOld <- unit(0, "cm") 
      stats.col[[ min(lstCur[[3]]) ]]$widths.left.max <- max(do.call(unit.c, list(valOld, valNew))) 

      # Right 
      valNew <- widths.right[[ i ]] 
      valOld <- stats.col[[ max(lstCur[[3]]) ]]$widths.right.max 
      if (is.null(valOld)) valOld <- unit(0, "cm") 
      stats.col[[ max(lstCur[[3]]) ]]$widths.right.max <- max(do.call(unit.c, list(valOld, valNew))) 

      # Top 
      valNew <- heights.top[[ i ]] 
      valOld <- stats.row[[ min(lstCur[[2]]) ]]$heights.top.max 
      if (is.null(valOld)) valOld <- unit(0, "cm") 
      stats.row[[ min(lstCur[[2]]) ]]$heights.top.max <- max(do.call(unit.c, list(valOld, valNew))) 

      # Bottom 
      valNew <- heights.bottom[[ i ]] 
      valOld <- stats.row[[ max(lstCur[[2]]) ]]$heights.bottom.max 
      if (is.null(valOld)) valOld <- unit(0, "cm") 
      stats.row[[ max(lstCur[[2]]) ]]$heights.bottom.max <- max(do.call(unit.c, list(valOld, valNew))) 
     } 

     for(i in seq_along(dots)){ 
      lstCur <- lstAll[[i]] 
      nWidthLeftMax <- stats.col[[ min(lstCur[[ 3 ]]) ]]$widths.left.max 
      nWidthRightMax <- stats.col[[ max(lstCur[[ 3 ]]) ]]$widths.right.max 
      nHeightTopMax <- stats.row[[ min(lstCur[[ 2 ]]) ]]$heights.top.max 
      nHeightBottomMax <- stats.row[[ max(lstCur[[ 2 ]]) ]]$heights.bottom.max 
      pushViewport(viewport(layout.pos.row=lstCur[[2]], 
         layout.pos.col=lstCur[[3]], just=c("left","top"))) 
      pushViewport(viewport(
         x=unit(0, "npc") + nWidthLeftMax - widths.left[[i]], 
         y=unit(0, "npc") + nHeightBottomMax - heights.bottom[[i]], 
         width=unit(1, "npc") - nWidthLeftMax + widths.left[[i]] - 
               nWidthRightMax + widths.right[[i]], 
         height=unit(1, "npc") - nHeightBottomMax + heights.bottom[[i]] - 
               nHeightTopMax + heights.top[[i]], 
         just=c("left","bottom"))) 
      grid.draw(dots[[i]]) 
      upViewport(2) 
     } 

    } 
    #-----\align function----- 

    # edge margins 
    margin1 = 0.1 
    margin2 = -0.9 
    margin3 = 0.5 

    plot <- ggplot(data = dsmall) + geom_point(mapping = aes(x = x, y = depth, colour = cut)) + opts(legend.position="none") 
    plot <- plot + opts(axis.text.x = theme_blank(), axis.ticks = theme_blank(), axis.title.x = theme_blank()) 
    plot1 <- plot + opts(plot.margin=unit.c(unit(margin1, "lines"), unit(margin1,"lines"), unit(margin2,"lines"), unit(margin3,"lines"))) 

    plot <- ggplot(data = dsmall) + geom_point(mapping = aes(x = y, y = depth, colour = cut)) + opts(legend.position="none") 
    plot <- plot + opts(axis.text.x = theme_blank(), axis.ticks = theme_blank(), axis.title.x = theme_blank(), axis.text.y = theme_blank(), axis.title.y = theme_blank()) 
    plot2 <- plot + opts(plot.margin=unit.c(unit(margin1, "lines"), unit(margin1,"lines"), unit(margin2,"lines"), unit(margin2,"lines"))) 

    plot <- ggplot(data = dsmall) + geom_point(mapping = aes(x = z, y = depth, colour = cut)) + opts(legend.position="none") 
    plot <- plot + opts(axis.text.x = theme_blank(), axis.ticks = theme_blank(), axis.title.x = theme_blank(), axis.text.y = theme_blank(), axis.title.y = theme_blank()) 
    plot3 <- plot + opts(plot.margin=unit.c(unit(margin1, "lines"), unit(margin1,"lines"), unit(margin2,"lines"), unit(margin2,"lines"))) 

    plot <- ggplot(data = dsmall) + geom_point(mapping = aes(x = x, y = price, colour = cut)) + opts(legend.position="none") 
    plot <- plot + opts(axis.text.x = theme_blank(), axis.ticks = theme_blank(), axis.title.x = theme_blank()) 
    plot4 <- plot + opts(plot.margin=unit.c(unit(margin1, "lines"), unit(margin1,"lines"), unit(margin2,"lines"), unit(margin3,"lines"))) 

    plot <- ggplot(data = dsmall) + geom_point(mapping = aes(x = y, y = price, colour = cut)) + opts(legend.position="none") 
    plot <- plot + opts(axis.text.x = theme_blank(), axis.ticks = theme_blank(), axis.title.x = theme_blank(), axis.text.y = theme_blank(), axis.title.y = theme_blank()) 
    plot5 <- plot + opts(plot.margin=unit.c(unit(margin1, "lines"), unit(margin1,"lines"), unit(margin2,"lines"), unit(margin2,"lines"))) 

    plot <- ggplot(data = dsmall) + geom_point(mapping = aes(x = z, y = price, colour = cut)) + opts(legend.position="none") 
    plot <- plot + opts(axis.text.x = theme_blank(), axis.ticks = theme_blank(), axis.title.x = theme_blank(), axis.text.y = theme_blank(), axis.title.y = theme_blank()) 
    plot6 <- plot + opts(plot.margin=unit.c(unit(margin1, "lines"), unit(margin1,"lines"), unit(margin2,"lines"), unit(margin2,"lines"))) 

    plot <- ggplot(data = dsmall) + geom_point(mapping = aes(x = x, y = carat, colour = cut)) + opts(legend.position="none") 
    plot <- plot + opts(axis.ticks = theme_blank()) 
    plot7 <- plot + opts(plot.margin=unit.c(unit(margin1, "lines"), unit(margin1,"lines"), unit(margin3,"lines"), unit(margin3,"lines"))) 

    plot <- ggplot(data = dsmall) + geom_point(mapping = aes(x = y, y = carat, colour = cut)) + opts(legend.position="none") 
    plot <- plot + opts(axis.ticks = theme_blank(), axis.text.y = theme_blank(), axis.title.y = theme_blank()) 
    plot8 <- plot + opts(plot.margin=unit.c(unit(margin1, "lines"), unit(margin1,"lines"), unit(margin3,"lines"), unit(margin2,"lines"))) 

    plot <- ggplot(data = dsmall) + geom_point(mapping = aes(x = z, y = carat, colour = cut)) + opts(legend.position="none") 
    plot <- plot + opts(axis.ticks = theme_blank(), axis.text.y = theme_blank(), axis.title.y = theme_blank()) 
    plot9 <- plot + opts(plot.margin=unit.c(unit(margin1, "lines"), unit(margin1,"lines"), unit(margin3,"lines"), unit(margin2,"lines"))) 

    grid_layout <- grid.layout(nrow=3, ncol=3, widths=c(2,2,2), heights=c(2,2,2)) 
    grid.newpage() 
    pushViewport(viewport(layout=grid_layout)) 
    align.plots(grid_layout, 
      list(plot1, 1, 1), 
      list(plot2, 1, 2), 
      list(plot3, 1, 3), 
      list(plot4, 2, 1), 
      list(plot5, 2, 2), 
      list(plot6, 2, 3), 
      list(plot7, 3, 1), 
      list(plot8, 3, 2), 
      list(plot9, 3, 3)) 
} 

oryginalny obraz:

aktualny postęp image:

Answer 1

Istnieje funkcja align.plots w ggExtra pakiet. Sprawdź ten wątek z listy ggplot2 korespondencji: Aligning time series plots

aligned plots http://img138.imageshack.us/img138/6786/aligngrid.png

Answer 2

Oto prosty sposób z ggplot2 i stopić:

diamonds_sample <- diamonds[sample(nrow(diamonds), 100), ] 

melted_diamonds <- melt(diamonds_sample, measure.vars=c('x','y','z'), 
    variable_name='letter') 
# rename the melt results to avoid confusion with next melt 
# (bug in melt means you can't rename the value during melt) 
names(melted_diamonds)[9] <- 'letter.value' 

melted_diamonds <- melt(melted_diamonds, 
    measure.vars=c('depth', 'price', 'carat'), variable_name='variables') 

ggplot(melted_diamonds, aes(x=letter.value, y=value, colour=cut)) + 
    geom_point() + facet_grid(variables~letter, scale='free') 

Wynik:

Można przykręcić wokół wszystkich opcji ggplot2, aby pojawiły się karty odpowiednie miejsca i usunąć legendę.

---

Uwaga: dla działek, takich jak ten, w którym chcesz porównać wiele zmiennych parami, sprawdź the GGally package. Jest tu kilka dokumentów: http://rgm2.lab.nig.ac.jp/RGM2/func.php?rd_id=GGally:ggpairs.