参考

Question

我希望以类似于Likert图表的方式显示成对的数据，但是使用辅助轴。我发现这个图表看起来正是我想要的。

有谁知道如何创建s.th.类似或有一个关于如何将次轴添加到李克特图表的示例，或者有关如何以巧妙的方式呈现类似数据的任何想法？

Answer 1

我喜欢尝试从原始图形元素和手动坐标计算中构建这些类型的图。它使您可以完全控制绘图的所有方面，但代价是绘图代码中的复杂性和复杂性。

你走了：

## generate data
df <- data.frame(region=rep(c('OECD','Non-OECD Europe and Eurasia','China','Bunkers','Asia','Non-OECD Americas','Africa','Middle East'),each=2L),year=c(1973L,2010L),emissions=c(68,41,17,9,7,23,5,4,4,12,3,4,2,3,1,7));
df;
##                         region year emissions
## 1                         OECD 1973        68
## 2                         OECD 2010        41
## 3  Non-OECD Europe and Eurasia 1973        17
## 4  Non-OECD Europe and Eurasia 2010         9
## 5                        China 1973         7
## 6                        China 2010        23
## 7                      Bunkers 1973         5
## 8                      Bunkers 2010         4
## 9                         Asia 1973         4
## 10                        Asia 2010        12
## 11           Non-OECD Americas 1973         3
## 12           Non-OECD Americas 2010         4
## 13                      Africa 1973         2
## 14                      Africa 2010         3
## 15                 Middle East 1973         1
## 16                 Middle East 2010         7

## set configuration parameters
xlim <- c(0,1);
ylim <- c(0,1);
ybararea.pct <- 86;
ybargap.ratio <- 2.2; ## bar/gap; really describes larger bars, i.e. 2010 bars to gaps
ybar1973.pct <- 55; ## 1973 pct height of 2010
x.range.1973 <- c(0,100);
x.ticks.1973 <- seq(x.range.1973[1L],x.range.1973[2L],20);
x.range.2010 <- c(0,51.5);
x.ticks.2010 <- seq(x.range.2010[1L],x.range.2010[2L],10);
y.wrap <- 16;
col.1973 <- '#3377BB';
col.2010 <- '#BBCCEE';
col.axis <- '#888888';
legend.x <- 0.77;
legend.y <- 0.2;
legend.overlap <- 0.01;
legend.spread <- 0.033;

## precompute derived parameters
h <- (1-ybararea.pct/100)/2*diff(ylim); ybararea.range <- c(ylim[1L]+h,ylim[2L]-h);
regions <- unique(df$region);
NB <- length(regions);
ybar.height.max <- diff(ybararea.range)/(NB + (NB-1L)/ybargap.ratio); ## this formula can be derived
ybar.height.2010 <- ybar.height.max;
ybar.height.1973 <- ybar.height.2010*ybar1973.pct/100;
ybar.centers <- rev(seq(ybararea.range[1L]+ybar.height.max/2,ybararea.range[2L]-ybar.height.max/2,len=NB));

## helper function
xscale <- function(x,r,xlim=c(0,1)) xlim[1L]+(x-r[1L])/diff(r)*diff(xlim);

## plot
par(mar=c(5,7,4,2)+0.1);
plot(NA,xlim=xlim,ylim=ylim,xaxs='i',yaxs='i',axes=F,ann=F);
## bars
with(df[df$year==2010L,],rect(xscale(0,x.range.2010),ybar.centers-ybar.height.2010/2,xscale(emissions,x.range.2010),ybar.centers+ybar.height.2010/2,col=col.2010,border=NA));
with(df[df$year==1973L,],rect(xscale(0,x.range.1973),ybar.centers-ybar.height.1973/2,xscale(emissions,x.range.1973),ybar.centers+ybar.height.1973/2,col=col.1973,border=NA));
## x-axes
segments(xlim[1L],ylim[1L],xlim[2L],col=col.axis);
axis(3L,xscale(x.ticks.1973,x.range.1973),x.ticks.1973,col=col.axis,padj=0.8);
mtext(expression(paste('Percentage of total ',CO[2],' emissions for 1973')),3L,1.75);
segments(xlim[1L],ylim[2L],xlim[2L],col=col.axis);
axis(1L,xscale(x.ticks.2010,x.range.2010),x.ticks.2010,col=col.axis,padj=-0.8);
mtext(expression(paste('Percentage of total ',CO[2],' emissions for 2010')),1L,1.75);
## y-axis
mtext(lapply(regions,function(x) paste(collapse='\n',strwrap(x,y.wrap))),2L,0.3,las=2L,at=ybar.centers);
## legend
rect(legend.x-legend.overlap,legend.y-ybar.height.2010/2,legend.x+legend.spread,legend.y+ybar.height.2010/2,col=col.2010,border=NA);
rect(legend.x-legend.spread,legend.y-ybar.height.1973/2,legend.x+legend.overlap,legend.y+ybar.height.1973/2,col=col.1973,border=NA);
text(legend.x-legend.spread,legend.y,'1973',pos=2L,offset=0.1);
text(legend.x+legend.spread,legend.y,'2010',pos=4L,offset=0.1);

R带有次轴的李克特图

1 个答案:

参考