5

我有一个主要是美容问题。我正在使用 ggplot2 库创建四个图,然后将它们排列在一列中(使用this)。图表显示相同的数据,但对于四组,x 轴是时间,这就是为什么我想将图表保留在一列中的原因。

所以我将图例添加到顶部图表,并将 x 轴的标签添加到底部图表。这两个动作改变了图表的大小;添加图例会导致图形增长,添加 x 轴标签会导致图形缩小以适应这些内容。

有没有办法指定一个固定的图形大小,这会使我的布局保持一致?

我的情节: 阴谋

可重现结果的代码:

library(ggplot2)
library(reshape)

raw_data <- structure(list(Sample = c(1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 
10L, 11L, 12L, 13L, 14L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L, 
23L, 24L, 25L, 26L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 
11L, 12L, 13L, 14L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 
24L, 25L, 26L), Month = structure(c(12L, 12L, 11L, 11L, 10L, 
10L, 3L, 3L, 5L, 5L, 4L, 4L, 8L, 8L, 1L, 1L, 9L, 9L, 7L, 7L, 
6L, 6L, 2L, 2L, 12L, 12L, 12L, 12L, 11L, 11L, 10L, 10L, 3L, 3L, 
5L, 5L, 4L, 4L, 8L, 8L, 1L, 1L, 9L, 9L, 7L, 7L, 6L, 6L, 2L, 2L, 
12L, 12L), .Label = c("April", "Aug", "Dec", "Feb", "Jan", "July", 
"June", "March", "May", "Nov", "Oct", "Sep"), class = "factor"), 
    Channel = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
    2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("A", 
    "B"), class = "factor"), Amplitude = c(5000L, 
    5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 
    5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 
    5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 
    5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 5000L, 5000L)), .Names = c("Sample", 
"Month", "Channel", "Amplitude"), row.names = c(NA, 52L), class = "data.frame")



multiplot <- function(..., plotlist=NULL, cols) {
    require(grid)

    # Make a list from the ... arguments and plotlist
    plots <- c(list(...), plotlist)

    numPlots = length(plots)

    # Make the panel
    plotCols = cols                          # Number of columns of plots
    plotRows = ceiling(numPlots/plotCols) # Number of rows needed, calculated from # of cols

    # Set up the page
    grid.newpage()
    pushViewport(viewport(layout = grid.layout(plotRows, plotCols)))
    vplayout <- function(x, y) {
            viewport(layout.pos.row = x, layout.pos.col = y)
    }

    # Make each plot, in the correct location
    for (i in 1:numPlots) {
        curRow = ceiling(i/plotCols)
        curCol = (i-1) %% plotCols + 1
        print(plots[[i]], vp = vplayout(curRow, curCol))
    }

}


mybarplot <- function(first=0, last=0) {
    # Create the barplot 
    p <- ggplot(raw_data, aes(x=Sample, y=Amplitude, fill=Channel))

    # Make it a grouped barplot with already summarised values
    p <- p +  geom_bar(position="dodge", stat="identity")


    # Apply a log10 transformation to the y-axis, and create appropriate axis ticks
    p <- p + scale_y_log10(breaks = c(5,10,50,100,500,1000,5000,10000))

    # Zoom in (barplots will not show when axis change to remove 0, so have to zoom)
    p <- p + coord_cartesian(ylim=c(1,15000), xlim=c(1,26))

    # Make it greyscale
    p <- p + scale_fill_grey()


    # Hide X label
    p <- p + opts(axis.text.x=theme_blank(), axis.title.x=theme_blank(), axis.title.y=theme_blank())
    # Change X label size
    p <- p + opts(axis.text.y=theme_text(size=7))



    # Change the Legend
    p <- p + scale_fill_manual(values=c("black", "grey75", "grey25"), name="Channel", breaks=c("A", "B"))

    #margins
    # c(top,,bottom,)
    top_margin    <- unit(c(    1, 1, -0.25, 1), "lines")
    middle_margin <- unit(c(-0.25, 1, -0.25, 1), "lines")
    bottom_margin <- unit(c(-0.25, 1,     2, 1), "lines")


    if (first) {
        # Anchor legend box to top right corner
        p <- p + opts(legend.justification=c(1,1), legend.position=c(1,1))
        # Put a white box around it
        p <- p + opts(legend.background = theme_rect(fill="white"))
        # Top margin
        p <- p + opts(plot.margin = top_margin)
        p <- p + scale_x_discrete(breaks = 1:26)
    } else {
        p <- p + opts(legend.position="none")
        if (last) {
            # Bottom margin
            p <- p + opts(plot.margin = bottom_margin)
                # label X-axis
            p <- p + scale_x_discrete(breaks = 1:26, labels=c("Sep", "", "Oct", "", "Nov", "", "Dec", "", "Jan", "", "Feb", "", "March", "", "April", "", "May", "", "June", "", "July", "", "Aug", "", "Sep", ""))

            p <- p + ylab("Amplitude")
            p <- p + xlab("Sampling time")
            # Angle x labels
            #p <- p + opts(axis.text.x=theme_text(angle=-45, hjust=0.5))
            p <- p + opts(axis.text.x=theme_text(hjust=0.5))

            # Move X title
            p <- p + opts(axis.title.x=theme_text(vjust=-0.5))
        } else {
            p <- p + opts(plot.margin = middle_margin)
            p <- p + scale_x_discrete(breaks = 1:26)
        }
    }



}


plot1 <- mybarplot(first=1)
plot2 <- mybarplot()
plot3 <- mybarplot()
plot4 <- mybarplot(last=1)

multiplot(plot1, plot2, plot3, plot4, cols=1)

会话信息:

> sessionInfo()
R version 2.15.1 (2012-06-22)
Platform: x86_64-apple-darwin9.8.0/x86_64 (64-bit)

locale:
[1] C

attached base packages:
[1] grid      stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] reshape_0.8.4 plyr_1.7.1    ggplot2_0.9.1

loaded via a namespace (and not attached):
 [1] MASS_7.3-18        RColorBrewer_1.0-5 colorspace_1.1-1   dichromat_1.2-4    digest_0.5.2       labeling_0.1       memoise_0.1        munsell_0.3        proto_0.3-9.2      reshape2_1.2.1    
[11] scales_0.2.1       stringr_0.6.1     
4

1 回答 1

5

在您的示例中,每个情节都是相同的,但是我认为这不是您最终产品的计划。我认为最简单的方法是分面,而不是单独布置每个情节。

dat <- data.frame(facetvar=letters[1:5], yvar=rep(1:10, each=5), xvar=rep(letters[6:10], each=5))
ggplot(dat, aes(x=xvar, y=yvar, group=facetvar)) + 
    geom_bar(stat='identity') + 
    facet_grid(facetvar~.)

如果需要,您可以先对数据进行子集化,然后使用任意构面变量。

ggplot(dat[sample(1:50, 40),], aes(x=xvar, y=yvar, group=facetvar)) + 
    geom_bar(stat='identity') + 
    facet_grid(facetvar~.)

如果需要,您也可以提供scales.y='free'给。facet_grid()

于 2012-10-02T15:36:46.967 回答