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％的柱仍然在右边时停止：< / p>

我尝试过的事情：

将xaxis替换为bp并在第一个中设置labels = xlabs 调用axis() - 这确实使轴跨越整个图表，但它添加太多刻度线;
将xaxis替换为pretty(bp) - 这为我提供了合适的尺寸轴和适当间隔的刻度线，但刻度标签不对应到我的数据框，最右边的值超过了数据框的最大值;
将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参数

需要进行一些其他修改以实现相对于条形的刻度线的适当间距 - （如用户2551530所指出的）

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)
}

Base R Bar绘制x轴倾斜

2 个答案: