Авторазмер и фиксированная ширина баров в пробирке - PullRequest
Новая
       32

Авторазмер и фиксированная ширина баров в пробирке

1 голос
/ 04 мая 2019

У меня проблемы, и я точно не знаю, как объяснить, так что извините заранее.

У меня есть сценарий, который я не буду здесь размещать, так как он очень большой, поэтому давайте перейдем непосредственно к проблеме.

Поскольку скрипт генерирует логотип, который является своего рода гистограммой, я попытаюсь смоделировать проблему на примере.

Я использую функцию для разделения гистограммы по количеству столбцов, в конце она генерирует график с различными гробами, каждый из которых содержит часть гистограммы. 

myranges <- function(start, end, step){
  starts <- seq(start, end, step+1)
  ends <- pmin(starts + step, end)
  data.frame(a = starts, b = ends)
}

d <- data.frame(a = letters[1:10] , b = seq(1, 20, by =2 ))


num_bar_per_hist <- 2

p_list <- apply(
  myranges(1, nrow(d), num_bar_per_hist - 1),
  1,
  function(x){
    #as.matrix(d[x[1]:x[2]],)
    ggplot(d[x[1]:x[2] , ], aes(x=a, y=b)) + 
      geom_bar(stat = "identity") +
      ylim(0,22) +
      theme_classic()
  }
)
do.call(gridExtra::grid.arrange, c(p_list, ncol=2))

Выше фрагмент сценария, который генерирует сюжет.
Я изменяю var num_bar_per_hist, чтобы разделить гистограмму. В этом примере я получил это:

enter image description here

Если я изменю значение num_bar_per_hist на 5, я получу:

enter image description here

Эти два примера показывают, что ширина каждого графика остается неизменной, а также ширина столбцов.
Но если я поменяю num_bar_per_hist на 3, я получу:

enter image description here

Что бы я хотел, чтобы ширина полосок была одинаковой. Это означает, что полоса j должна быть выровнена и иметь ту же ширину полосы d, что и справа вверху.

Также, если это возможно, я бы не хотел менять структуру скрипта (слишком много) или просто / мелкие изменения.

Я заранее благодарен. Спасибо

EDIT:

Используя cowplot, я мог бы решить часть проблемы. (тот же параметр 3-го участка) 

num_bar_per_hist <- 3

p_list <- apply(
  myranges(1, nrow(d), num_bar_per_hist - 1),
  1,
  function(x){
    ggdraw() +
      draw_plot(
        ggplot(d[x[1]:x[2] , ], aes(x=a, y=b)) + 
          geom_bar(stat = "identity") +
          ylim(0, 22),
        width = (x[2] - x[1] + 1) / num_bar_per_hist
      )
  }
)
do.call(gridExtra::grid.arrange, c(p_list, ncol=2))

Таким образом, я получил:

enter image description here

Таким образом, я приближаюсь к решению. j по-прежнему имеет ту же ширину, что и остальные, но слишком лучше, чем третий график.
Мне все еще нужен какой-то трюк или «магическое число», чтобы увеличить ширину полосы. Из-за этой стратегии лидерство последний гроб стал тоньше, чем другие. И я просто хочу сохранить все бары одинаковой ширины независимо от разницы количества баров на каждом графике.

1 Ответ

1 голос
/ 06 мая 2019

вы можете выкопать количество разрывов, и оттуда изменить каждый график, чтобы убедиться, что все они имеют столько же разрывов, добавив фиктивные в шкалу х, 

how_many <- function(p){
  gb <- ggplot_build(p)
  length(gb$layout$panel_params[[1]][['x.major']])
}

raxe <- function(p, n){

  gb <- ggplot_build(p)
  x_params <- gb$layout$panel_params[[1]]
  ni <- length(x_params[['x.major']])
  labels <- x_params[['x.labels']]
  if(ni < n){
    dummy <- c(labels, paste0("__",letters[seq_len(n-ni)]))
    print(dummy)
    phantom <- c(labels, rep('', n-ni))
    return(p + scale_x_discrete(lim=dummy, labels=phantom))
  }
p
}

n_breaks <- sapply(p_list, how_many)
p_list <- lapply(p_list, raxe, max(n_breaks))

egg::ggarrange(plots = p_list, ncol=2)
...