Base R Bar Plot X-axis skewing - PullRequest
       40

Base R Bar Plot X-axis skewing

0 голосов
/ 18 мая 2018

Я пишу функцию для построения (например, в 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% стержней все еще остаются вправо:

enter image description here

Вещи Iпробовал:

  1. заменив xaxis на bp и установив labels = xlabs при первом вызове axis() - это заставляет ось охватывать весь график, но добавляетслишком много отметок;

  2. замена xaxis на pretty(bp) - это дает мне правильный размер для моей оси и правильно расположенные отметки, но отметки не соответствуютмой датафрейм и самое правое значение превышают максимум фрейма данных;

  3. , заменив xaxis на pretty(bp) и установив labels = pretty(df[,1],n=length(xaxis)-1,min.n=length(xaxis)-1) (аргумент min.n должен использоваться, иначе ошибкаброшен) - проблема с этим подходом заключается в том, что крайнее левое значение оси х равно -20, что далеко за пределамиреальный диапазон;

У меня заканчиваются идеи, но я чувствую, что это простая вещь, и поэтому я должен упустить простую настройку графического параметра, которая даст мне то, что я хочу,Как лучше всего продолжить?

Спасибо!

Ответы [ 2 ]

0 голосов
/ 18 мая 2018

Изменить на

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

Примечание * Аргумент space = 0

Требуется несколько других модификаций для достижения правильного расстояния между отметками тиков относительно столбцов - (как указано пользователем2554330)

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)
}
0 голосов
/ 18 мая 2018

@ Джоран прав, вам нужно использовать 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) производит это:

enter image description here

...