具有误差条和吐出y轴的组条形图

时间：2016-03-14 05:30:49

标签： r

我想绘制一个带有误差条和分割y轴的组条形图，以在同一个图中显示更小和更大的值？ （如我的数据样本1中所示，与其他样本相比，样本数值较小，因此，我希望在y轴上产生10-200之间的间隙）

这是我的数据，

sample  mean    part    sd
1   4.3161  G   1.2209
1   2.3157  F   1.7011
1   1.7446  R   1.1618
2   1949.13 G   873.42
2   195.07  F   47.82
2   450.88  R   140.31
3   2002.98 G   367.92
3   293.45  F   59.01
3   681.99  R   168.03
4   2717.85 G   1106.07
4   432.83  F   118.02
4   790.97  R   232.62

2 个答案:

答案 0 :(得分：1)

您可以使用原始图形元素执行任何操作。出于这个原因，我总是喜欢用基本的R绘图函数来设计我自己的绘图，特别是points()，segments()，lines()，abline()，rect() ，polygon()，text()和mtext()。您可以使用自己定义的粒度坐标向量中的segments()和lines()轻松创建曲线（例如圆圈）和更复杂的形状。例如，请参阅Plot angle between vectors。这样可以更好地控制您创建的绘图元素，但是，与更多预先打包的解决方案相比，它通常需要更多的工作和仔细的编码，因此这是一种权衡。

数据

首先，以可运行的形式提供您的数据：

df <- data.frame(
    sample=c(1,1,1,2,2,2,3,3,3,4,4,4),
    mean=c(4.3161,2.3157,1.7446,1949.13,195.07,450.88,2002.98,293.45,681.99,2717.85,432.83,790.97),
    part=c('G','F','R','G','F','R','G','F','R','G','F','R'),
    sd=c(1.2209,1.7011,1.1618,873.42,47.82,140.31,367.92,59.01,168.03,1106.07,118.02,232.62),
    stringsAsFactors=F
);
df;
##    sample      mean part        sd
## 1       1    4.3161    G    1.2209
## 2       1    2.3157    F    1.7011
## 3       1    1.7446    R    1.1618
## 4       2 1949.1300    G  873.4200
## 5       2  195.0700    F   47.8200
## 6       2  450.8800    R  140.3100
## 7       3 2002.9800    G  367.9200
## 8       3  293.4500    F   59.0100
## 9       3  681.9900    R  168.0300
## 10      4 2717.8500    G 1106.0700
## 11      4  432.8300    F  118.0200
## 12      4  790.9700    R  232.6200

OP ggplot

现在，作为参考，这里是您粘贴到评论中的ggplot代码产生的图表的屏幕截图：

library(ggplot2);
ggplot(df,aes(x=as.factor(sample),y=mean,fill=part)) +
    geom_bar(position=position_dodge(),stat='identity',colour='black') +
    geom_errorbar(aes(ymin=mean-sd,ymax=mean+sd),width=.2,position=position_dodge(.9));

nuwanma

Linear Single

另外，作为参考，您可以使用基础R barplot()和legend()生成类似的分组条形图。我已将自定义调用的错误栏添加到segments()和points()：

## reshape to wide matrices
dfw <- reshape(df,dir='w',idvar='part',timevar='sample');
dfw.mean <- as.matrix(dfw[grep(perl=T,'^mean\\.',names(dfw))]);
dfw.sd <- as.matrix(dfw[grep(perl=T,'^sd\\.',names(dfw))]);
rownames(dfw.mean) <- rownames(dfw.sd) <- dfw$part;
colnames(dfw.mean) <- colnames(dfw.sd) <- unique(df$sample);

## plot precomputations
ylim <- c(0,4000);
yticks <- seq(ylim[1L],ylim[2L],100);
xcenters <- (col(dfw.sd)-1L)*(nrow(dfw.sd)+1L)+row(dfw.sd)+0.5;
partColors <- c(G='green3',F='indianred1',R='dodgerblue');
errColors <- c(G='darkgreen',F='darkred',R='darkblue');

## plot
par(xaxs='i',yaxs='i');
barplot(dfw.mean,beside=T,col=partColors,ylim=ylim,xlab='sample',ylab='mean',axes=F);
segments(xcenters,dfw.mean-dfw.sd,y1=dfw.mean+dfw.sd,lwd=2,col=errColors);
points(rep(xcenters,2L),c(dfw.mean-dfw.sd,dfw.mean+dfw.sd),pch=19,col=errColors);
axis(1L,par('usr')[1:2],F,pos=0,tck=0);
axis(2L,yticks,las=1L,cex.axis=0.7);
legend(2,3800,dfw$part,partColors,title=expression(bold('part')),cex=0.7,title.adj=0.5[2:1]);

linear-single

问题很明显。某些数据（样本1的含义和可变性）的细微差别在图中没有很好地表现出来。

对数

有两种标准选项可以解决此问题。一种是使用对数标度。您可以使用log='y'函数的barplot()参数执行此操作。覆盖默认的y轴刻度选择也很好，因为默认的基准R刻度在密度上有点亮，而在范围上很短。 （对于大多数基础R绘图类型，这实际上是正确的;我为axis()自定义调用我在此答案中生成的所有绘图。）

## plot precomputations
ylim <- c(0.1,4100); ## lower limit must be > 0 for log plot
yticks <- rep(10^seq(floor(log10(ylim[1L])),ceiling(log10(ylim[2L])),1),each=9L)*1:9;
xcenters <- (col(dfw.sd)-1L)*(nrow(dfw.sd)+1L)+row(dfw.sd)+0.5;
partColors <- c(G='green3',F='indianred1',R='dodgerblue');
errColors <- c(G='darkgreen',F='darkred',R='darkblue');

## plot
par(xaxs='i',yaxs='i');
barplot(log='y',dfw.mean,beside=T,col=partColors,ylim=ylim,xlab='sample',ylab='mean',axes=F);
segments(xcenters,dfw.mean-dfw.sd,y1=dfw.mean+dfw.sd,lwd=2,col=errColors);
points(rep(xcenters,2L),c(dfw.mean-dfw.sd,dfw.mean+dfw.sd),pch=19,col=errColors);
axis(1L,par('usr')[1:2],F,pos=0,tck=0);
axis(2L,yticks,yticks,las=1L,cex.axis=0.6);
legend(2,3000,dfw$part,partColors,title=expression(bold('part')),cex=0.7,title.adj=0.5[2:1]);

logarithmic

我们立即看到样本1的问题已修复。但我们引入了一个新问题：我们在其余数据中失去了精确度。换句话说，其余数据中存在的细微差别在视觉上较不明显。这是＆＃34;缩小＆＃34;不可避免的结果。从线性轴变为对数轴的效果。如果使用线性图但y轴太大，则会导致相同的精度损失，这就是为什么总是希望轴尽可能接近数据。这也表明对数y轴可能不是您数据的正确解决方案。当基础数据反映对数现象时，通常建议使用对数轴;它的范围超过几个数量级。在您的数据中，只有样本1与剩余数据处于不同的数量级;其余的集中在相同的数量级，因此不能用对数y轴表示。

线性多重

第二个选项是创建具有完全不同的y轴缩放的单独图。应该注意的是，ggplot faceting实际上是创建单独的图。此外，你可以用基数R创建multifigure图，但我通常发现这比它的价值更麻烦。通过单独生成每个绘图通常更容易，然后使用发布或文字处理软件将它们彼此相邻放置。

有多种方法可以自定义此方法，例如是否组合轴标签，放置图例的位置，尺寸和相对于彼此排列不同图的方式等。这是一种方法这样做：

##--------------------------------------
##  plot 1 -- high values
##--------------------------------------
dfw.mean1 <- dfw.mean[,-1L];
dfw.sd1 <- dfw.sd[,-1L];

## plot precomputations
ylim <- c(0,4000);
yticks <- seq(ylim[1L],ylim[2L],100);
xcenters <- (col(dfw.sd1)-1L)*(nrow(dfw.sd1)+1L)+row(dfw.sd1)+0.5;
partColors <- c(G='green3',F='indianred1',R='dodgerblue');
errColors <- c(G='darkgreen',F='darkred',R='darkblue');

par(xaxs='i',yaxs='i');
barplot(dfw.mean1,beside=T,col=partColors,ylim=ylim,xlab='sample',ylab='mean',axes=F);
segments(xcenters,dfw.mean1-dfw.sd1,y1=dfw.mean1+dfw.sd1,lwd=2,col=errColors);
points(rep(xcenters,2L),c(dfw.mean1-dfw.sd1,dfw.mean1+dfw.sd1),pch=19,col=errColors);
axis(1L,par('usr')[1:2],F,pos=0,tck=0);
axis(2L,yticks,las=1L,cex.axis=0.7);
legend(2,3800,dfw$part,partColors,title=expression(bold('part')),cex=0.7,title.adj=0.5[2:1]);

##--------------------------------------
##  plot 2 -- low values
##--------------------------------------
dfw.mean2 <- dfw.mean[,1L,drop=F];
dfw.sd2 <- dfw.sd[,1L,drop=F];

## plot precomputations
ylim <- c(0,6);
yticks <- seq(ylim[1L],ylim[2L],0.5);
xcenters <- (col(dfw.sd2)-1L)*(nrow(dfw.sd2)+1L)+row(dfw.sd2)+0.5;
partColors <- c(G='green3',F='indianred1',R='dodgerblue');
errColors <- c(G='darkgreen',F='darkred',R='darkblue');

par(xaxs='i',yaxs='i');
barplot(dfw.mean2,beside=T,col=partColors,ylim=ylim,xlab='sample',ylab='mean',axes=F);
segments(xcenters,dfw.mean2-dfw.sd2,y1=dfw.mean2+dfw.sd2,lwd=2,col=errColors);
points(rep(xcenters,2L),c(dfw.mean2-dfw.sd2,dfw.mean2+dfw.sd2),pch=19,col=errColors);
axis(1L,par('usr')[1:2],F,pos=0,tck=0);
axis(2L,yticks,las=1L,cex.axis=0.7);

linear-multiple

这解决了两个问题（小值可见性和大值精度）。但它也会扭曲样本2-4与样本1的相对大小。换句话说，样本1的数据已按比例放大＆＃34;相对于样本2-4，读者必须有意识地阅读轴并消化不同的尺度，以便正确理解这些图。

这里的教训是没有完美的解决方案。每种方法都有自己的优点和缺点，也有自己的权衡。

的Gapped

在您的问题中，您表示要在y范围10:200之间添加间隙。从表面上看，这听起来像是提高样本1数据可见性的合理解决方案。然而，190单位范围的幅度与图的其余部分的范围相比相形见绌，因此最终对样本1可见性的影响可以忽略不计。

为了证明这一点，我将使用我编写的一些代码，这些代码可用于将输入坐标转换为新的数据域，从而允许轴的不同段的不一致缩放。从理论上讲，你可以将它用于x轴和y轴，但我只是将它用于y轴。

一些警告：这引入了一些显着的复杂性，并将图形引擎的y轴刻度与真实数据的概念分离。更具体地说，它根据分段序列中的累积位置将所有坐标映射到范围[0,1]。

此时，我还将放弃barplot()，转而使用rect()调用手动绘制条形图。从技术上讲，可以将barplot()与我的分段代码一起使用，但正如我之前所说，我更喜欢从头开始用原始图形元素设计我自己的图。这也可以更精确地控制图的各个方面。

这里是代码和情节，之后我会尝试更好地解释它：

dataCoordToPlot <- function(data,seg) {
    ## data -- double vector of data-world coordinates.
    ## seg -- list of two components: (1) mark, giving the boundaries between all segments, and (2) scale, giving the relative scale of each segment. Thus, scale must be one element shorter than mark.
    data <- as.double(data);
    seg <- as.list(seg);
    seg$mark <- as.double(seg$mark);
    seg$scale <- as.double(seg$scale);
    if (length(seg$scale) != length(seg$mark)-1L) stop('seg$scale must be one element shorter than seg$mark.');
    scaleNorm <- seg$scale/sum(seg$scale);
    cumScale <- c(0,cumsum(scaleNorm));
    int <- findInterval(data,seg$mark,rightmost.closed=T);
    int[int%in%c(0L,length(seg$mark))] <- NA; ## handle values outside outer segments; will propagate NA to returned vector
    (data - seg$mark[int])/(seg$mark[int+1L] - seg$mark[int])*scaleNorm[int] + cumScale[int];
}; ## end dataCoordToPlot()

## y dimension segmentation
ymax <- 4000;
yseg <- list();
yseg$mark <- c(0,10,140,ymax);
yseg$scale <- diff(yseg$mark);
yseg$scale[2L] <- 30;
yseg$jump <- c(F,T,F);

## plot precomputations
xcenters <- seq(0.5,len=length(unique(df$sample)));
xlim <- range(xcenters)+c(-0.5,0.5);
ylim <- range(yseg$mark);
yinc <- 100;
yticks.inc <- seq(ylim[1L],ylim[2L],yinc);
yticks.inc <- yticks.inc[!yseg$jump[findInterval(yticks.inc,yseg$mark,rightmost.closed=T)]];
yticks.jump <- setdiff(yseg$mark,yticks.inc);
yticks.all <- sort(c(yticks.inc,yticks.jump));

## plot
## define as reusable function for subsequent examples
custom.barplot <- function() {
    par(xaxs='i',yaxs='i');
    plot(NA,xlim=xlim,ylim=dataCoordToPlot(ylim,yseg),axes=F,ann=F);
    abline(h=dataCoordToPlot(yticks.all,yseg),col='lightgrey');
    axis(1L,seq(xlim[1L],xlim[2L]),NA,tck=0);
    axis(1L,xcenters,unique(df$sample));
    axis(2L,dataCoordToPlot(yticks.inc,yseg),yticks.inc,las=1,cex.axis=0.7);
    axis(2L,dataCoordToPlot(yticks.jump,yseg),yticks.jump,las=1,tck=-0.008,hadj=0.1,cex.axis=0.5);
    mtext('sample',1L,2L);
    mtext('mean',2L,3L);
    xgroupRatio <- 0.8;
    xbarRatio <- 0.9;
    partColors <- c(G='green3',F='indianred1',R='dodgerblue');
    partsCanon <- unique(df$part);
    errColors <- c(G='darkgreen',F='darkred',R='darkblue');
    for (sampleIndex in seq_along(unique(df$sample))) {
        xc <- xcenters[sampleIndex];
        sample <- unique(df$sample)[sampleIndex];
        dfs <- df[df$sample==sample,];
        parts <- unique(dfs$part);
        parts <- parts[order(match(parts,partsCanon))];
        barWidth <- xgroupRatio*xbarRatio/length(parts);
        gapWidth <- xgroupRatio*(1-xbarRatio)/(length(parts)-1L);
        xstarts <- xc - xgroupRatio/2 + (match(dfs$part,parts)-1L)*(barWidth+gapWidth);
        rect(xstarts,0,xstarts+barWidth,dataCoordToPlot(dfs$mean,yseg),col=partColors[dfs$part]);
        barCenters <- xstarts+barWidth/2;
        segments(barCenters,dataCoordToPlot(dfs$mean + dfs$sd,yseg),y1=dataCoordToPlot(dfs$mean - dfs$sd,yseg),lwd=2,col=errColors);
        points(rep(barCenters,2L),dataCoordToPlot(c(dfs$mean-dfs$sd,dfs$mean+dfs$sd),yseg),pch=19,col=errColors);
    }; ## end for
    ## draw zig-zag cutaway graphic in jump segments
    zigCount <- 30L;
    jumpIndexes <- which(yseg$jump);
    for (jumpIndex in jumpIndexes) {
        if (yseg$scale[jumpIndex] == 0) next;
        jumpStart <- yseg$mark[jumpIndex];
        jumpEnd <- yseg$mark[jumpIndex+1L];
        lines(seq(xlim[1L],xlim[2L],len=zigCount*2L+1L),dataCoordToPlot(c(rep(c(jumpStart,jumpEnd),zigCount),jumpStart),yseg));
    }; ## end for
    legend(0.2,dataCoordToPlot(3800,yseg),partsCanon,partColors,title=expression(bold('part')),cex=0.7,title.adj=c(NA,0.5));
}; ## end custom.barplot()
custom.barplot();

gapped

关键功能是dataCoordToPlot()。这代表＆＃34;数据坐标以绘制坐标＆＃34;，其中＆＃34;绘制坐标＆＃34;是指[0,1]规范化域。

seg参数定义轴的分段和每个段的缩放。其mark组件指定每个段的边界，其scale组件为每个段提供比例因子。 n个分段必须具有n+1个边界才能完全定义每个分段的开始和结束位置，因此mark必须比scale长一个元素。

在使用之前，scale向量在函数内被归一化为总和为1，因此量值的绝对大小并不重要;重要的是它们的相对价值。

该算法是找到每个包含段的坐标，找到由坐标计算得到的段的累积距离，并计算段的相对比例，然后加上所有到达的累积距离先前的细分。

使用此设计，可以沿轴尺寸采用任何范围的坐标，并相对于其他线段向上或向下缩放。可以通过零刻度实现范围内的瞬时间隙。或者，您可以简单地缩小范围，使其具有一定的厚度，但对尺寸的进展贡献很小。在上图中，我使用后者来表示间隙，主要是因为我可以使用较小的厚度来增加锯齿状的美感，从视觉上可以看出是否存在间隙。

另外，我应该注意，我使用了10:140代替10:200来弥补差距。这是因为样本2 F部分错误栏向下延伸到147.25（195.07 - 47.82）。差异可以忽略不计。

如您所见，结果与Linear Single图基本相同。差距不足以提高样本1数据的可见性。

与差距

失真

只是为混合投入更多的可能性，现在冒险进入非标准且可能有问题的水域，我们可以使用分割变换将样本放大1个数量级，从而使其更加可见，同时仍然保持在单个图，直接与样本2-4一起。

对于这个例子，我保留了与10:140之间的差距，这样你就可以看到它没有躺在基线附近时的样子。

## y dimension segmentation
ymax <- 4000;
yseg <- list();
yseg$mark <- c(0,10,140,ymax);
yseg$scale <- c(24,1,75);
yseg$jump <- c(F,T,F);

## plot precomputations
xcenters <- seq(0.5,len=length(unique(df$sample)));
xlim <- range(xcenters)+c(-0.5,0.5);
ylim <- range(yseg$mark);
yinc1 <- 1;
yinc2 <- 100;
yticks.inc1 <- seq(ceiling(yseg$mark[1L]/yinc1)*yinc1,yseg$mark[2L],yinc1);
yticks.inc2 <- seq(ceiling(yseg$mark[3L]/yinc2)*yinc2,yseg$mark[4L],yinc2);
yticks.inc <- c(yticks.inc1,yticks.inc2);
yticks.jump <- setdiff(yseg$mark,yticks.inc);
yticks.all <- sort(c(yticks.inc,yticks.jump));

## plot
custom.barplot();

distorted-with-gap

无差距扭曲

最后，只是为了澄清差异不是段之间不一致缩放所必需的，这里的情节相同，但没有差距：

## y dimension segmentation
ymax <- 4000;
yseg <- list();
yseg$mark <- c(0,10,ymax);
yseg$scale <- c(25,75);
yseg$jump <- c(F,F);

## plot precomputations
xcenters <- seq(0.5,len=length(unique(df$sample)));
xlim <- range(xcenters)+c(-0.5,0.5);
ylim <- range(yseg$mark);
yinc1 <- 1;
yinc2 <- 100;
yticks.inc1 <- seq(ceiling(yseg$mark[1L]/yinc1)*yinc1,yseg$mark[2L],yinc1);
yticks.inc2 <- seq(ceiling(yseg$mark[2L]/yinc2)*yinc2,yseg$mark[3L],yinc2);
yticks.inc <- c(yticks.inc1,yticks.inc2);
yticks.jump <- setdiff(yseg$mark,yticks.inc);
yticks.all <- sort(c(yticks.inc,yticks.jump));

## plot
custom.barplot();

distorted-without-gap

原则上，线性多重解决方案和失真解决方案之间确实没有区别。两者都涉及竞争数量级的视觉扭曲。 Linear Multiple简单地将不同的数量级分成单独的图，而Distorted解决方案将它们组合到同一个图中。

支持使用线性倍数的最佳理由可能是，如果你使用扭曲，你可能会被大量数据科学家钉在十字架上，因为这是一种非标准的数据绘图方式。另一方面，人们可能会争辩说，扭曲的方法更简洁，有助于表示每个数据点沿数字线的相对位置。选择是你的。

答案 1 :(得分：0)

您想要绘制的是不连续的y轴。 此问题已在this post中介绍过，并且在ggplot2中似乎无法实现。 上述帖子的答案建议分面，日志缩放y轴和单独的图解决您的问题。 请查看Hadley Wickham here详述的原因，他认为损坏的y轴可能会在视觉上扭曲＆＃34;。

相关问题
最新问题