基本 R 条形图 x 轴倾斜

Question

我正在编写一个函数来绘制特定种类的“组合图”（例如，在 Excel 中称为）：即条形图 + 折线图。这是我的代码：

plot_combo_chart <- function(df,bar_colour = "green",line_colour = 
"red",y_ticks = 5){

  x_name <- colnames(df)[1]
  bar_name <- colnames(df)[2]
  line_name <- colnames(df)[3]
  plot_colours <- c(bar_colour,line_colour)

  x_min <- min(df[,1])
  x_max <- max(df[,1])
  y_min <- min(df[,2],df[,3])
  y_max <- max(df[,2],df[,3])

  yaxis <- pretty(c(df[,2],df[,3]),n=y_ticks)

  par(xpd=FALSE)
  bp <- barplot(df[,2],col=bar_colour,axes = FALSE,ann=FALSE)
  xaxis <- pretty(df[,1])
  xlabs <- df[,1]

  lines(x=bp,df[,3], col=line_colour,lwd=2)
  axis(side=1,at=xaxis,labels = xaxis,xlim=c(x_min,x_max))
  axis(side=2,at=yaxis,labels = yaxis, ylim = c(y_min,y_max))
  legend(x=max(bp),y=y_max,legend = 
      c(bar_name,line_name),col=plot_colours,pch = c(NA,NA),bty='n', lwd=2,
      lty=c(0,1),xjust=1,yjust=0,fill=c(bar_colour,NA), 
      border=c(bar_colour,NA),xpd=TRUE)
      title(xlab = x_name)
}

我已经为函数生成了一些测试数据：

test <- data.frame(sample = 1:100, value1 = rnorm(100),value2 = runif(100))

当我使用 plot_combo_chart(test) 对测试数据运行脚本时遇到的问题是 x 轴太短，并且在大约 20% 的条形图仍然从左到右时停止：

我尝试过的事情：

1. 将xaxis 替换为bp 并在第一个设置labels = xlabs 致电axis() - 这确实使轴跨越整个图表，但它 添加了太多的刻度线；

2. 用 pretty(bp) 替换 xaxis - 这给了我适合我的尺寸 轴和适当间隔的刻度线，但刻度线标签不对应 到我的数据框，最右边的值超过了数据框的最大值；

3. 将xaxis 替换为pretty(bp) 并设置 labels = pretty(df[,1],n=length(xaxis)-1,min.n=length(xaxis)-1) （必须使用 min.n 参数，否则会引发错误） - 这种方法的问题是最左边的x轴值为-20， 远远超出实际范围；

我的想法已经不多了，但我觉得这是一件简单的事情，所以我一定错过了一个简单的图形参数设置，它会给我想要的东西。最好的方法是什么？

谢谢！

Answer 1

@joran 是对的，您需要使用bp 来设置轴，但这有点复杂，因为您想正确地重新缩放。而不是这个块：

  bp <- barplot(df[,2],col=bar_colour,axes = FALSE,ann=FALSE)
  xaxis <- pretty(df[,1])
  xlabs <- df[,1]

  lines(x=bp,df[,3], col=line_colour,lwd=2)
  axis(side=1,at=xaxis,labels = xaxis,xlim=c(x_min,x_max))

您需要计算出bp 值和df[,1] 值之间的关系。我假设它们之间存在线性关系（因为两者从最小到最大间隔相等）。我们对标签使用原始计算，但将它们放在offset + scale*xaxis 而不是xaxis：此代码进行转换：

  bp <- barplot(df[,2],col=bar_colour,axes = FALSE,ann=FALSE)
  b_min <- min(bp) # new
  b_max <- max(bp) # new
  xaxis <- pretty(df[,1])
  scale <- (b_max - b_min)/(x_max - x_min) # new
  offset <- b_min - x_min*scale            # new
  xlabs <- df[,1]

  lines(x=bp,df[,3], col=line_colour,lwd=2)
  axis(side=1,at=offset + scale*xaxis,labels = xaxis,xlim=c(b_min,b_max)) # changed

这是完整的功能，其中包含更改：

plot_combo_chart <- function(df, bar_colour = "green", line_colour = "red", 
                             y_ticks = 5){

  x_name <- colnames(df)[1]
  bar_name <- colnames(df)[2]
  line_name <- colnames(df)[3]
  plot_colours <- c(bar_colour,line_colour)

  x_min <- min(df[,1])
  x_max <- max(df[,1])
  y_min <- min(df[,2],df[,3])
  y_max <- max(df[,2],df[,3])

  yaxis <- pretty(c(df[,2],df[,3]),n=y_ticks)

  par(xpd=FALSE)
  bp <- barplot(df[,2],col=bar_colour,axes = FALSE,ann=FALSE)
  b_min <- min(bp)
  b_max <- max(bp)
  xaxis <- pretty(df[,1])
  scale <- (b_max - b_min)/(x_max - x_min)
  offset <- b_min - x_min*scale
  xlabs <- df[,1]

  lines(x=bp,df[,3], col=line_colour,lwd=2)
  axis(side=1,at=offset + scale*xaxis,labels = xaxis,xlim=c(b_min,b_max))
  axis(side=2,at=yaxis,labels = yaxis, ylim = c(y_min,y_max))
  legend(x=max(bp),y=y_max,legend = 
      c(bar_name,line_name),col=plot_colours,pch = c(NA,NA),bty='n', lwd=2,
      lty=c(0,1),xjust=1,yjust=0,fill=c(bar_colour,NA), 
      border=c(bar_colour,NA),xpd=TRUE)
      title(xlab = x_name)
}

然后plot_combo_chart(test) 产生这个：

Answer 2

改成

bp <- barplot(df[,2], col=bar_colour, space=0, axes = FALSE, ann=FALSE)

注意space = 0 参数

需要进行一些其他修改才能实现刻度线相对于条的适当间距 - （正如 user2554330 所指出的）

xaxis <- pretty(df[,1]) - 0.5     # offset values to midpoint of bar
xlabs <- xaxis + 0.5
axis(side=1,at=xaxis,labels = xlabs,xlim=c(x_min,x_max))  # you originally had labels = xaxis

修改后的功能如下

    plot_combo_chart <- function(df,bar_colour = "green",line_colour = 
"red",y_ticks = 5){

  x_name <- colnames(df)[1]
  bar_name <- colnames(df)[2]
  line_name <- colnames(df)[3]
  plot_colours <- c(bar_colour,line_colour)

  x_min <- min(df[,1])
  x_max <- max(df[,1])
  y_min <- min(df[,2],df[,3])
  y_max <- max(df[,2],df[,3])

  yaxis <- pretty(c(df[,2],df[,3]),n=y_ticks)

  par(xpd=FALSE)
  bp <- barplot(df[,2],col=bar_colour,space=0,axes = FALSE,ann=FALSE)
  xaxis <- pretty(df[,1])-0.5
  xlabs <- xaxis+0.5

  lines(x=bp,df[,3], col=line_colour,lwd=2)
  axis(side=1,at=xaxis,labels = xlabs,xlim=c(x_min,x_max))
  axis(side=2,at=yaxis,labels = yaxis, ylim = c(y_min,y_max))
  legend(x=max(bp),y=y_max,legend = 
      c(bar_name,line_name),col=plot_colours,pch = c(NA,NA),bty='n', lwd=2,
      lty=c(0,1),xjust=1,yjust=0,fill=c(bar_colour,NA), 
      border=c(bar_colour,NA),xpd=TRUE)
      title(xlab = x_name)
}