Как легко поддерживать одинаковый масштаб оси для двух гистограмм - PullRequest
0 голосов
/ 03 февраля 2020

Видел некоторый похожий код, но мне было любопытно, возможно ли это с пакетом gridExtra. Я хочу показать их в одном масштабе по осям X и Y. Нужно сделать это и для боксов. Есть ли более простой способ сделать это с помощью grid.arrange ()?

enter image description here

library(tidyverse)
library(gridExtra)

#Subset of Data
za <- structure(list(sodium = c(1.77, 1.79, 1.63, 1.61, 1.64, 1.65, 
1.58, 1.75, 1.71, 1.66), cal = c(4.93, 4.84, 4.95, 4.74, 4.67, 
4.67, 4.63, 4.72, 4.93, 4.95)), class = c("tbl_df", "tbl", "data.frame"
), row.names = c(NA, -10L))

#Histogram
sodHist <- ggplot(data = za, mapping = aes(x = sodium)) +
  geom_histogram(fill = "royalblue1", color = "white") +
  ggtitle("Sodium Distribution of Pizzas")

calHist <- ggplot(data = za, mapping = aes(x = cal)) +
  geom_histogram(fill = "limegreen", color = "white") +
  ggtitle("Calorie Distribution of Pizzas")

grid.arrange(sodHist,calHist, ncol = 2)

Ответы [ 2 ]

3 голосов
/ 04 февраля 2020

Проблема в том, что вы вводите два гроба в grid.arrange с уже установленными осями. Самый простой способ сделать оси y равными, вероятно, это «взломать» базовые ggplots и сделать их оси внутренне равными:

grid.arrange.equal <- function(plotA, plotB, ...)
{
  A <- ggplot_build(plotA)
  B <- ggplot_build(plotB)
  if(A$layout$panel_scales_y[[1]]$range$range[2] > B$layout$panel_scales_y[[1]]$range$range[2])
  B$layout$coord$limits$y <- A$layout$panel_scales_y[[1]]$range$range
  else
  A$layout$coord$limits$y <- B$layout$panel_scales_y[[1]]$range$range

  grid.arrange(A$plot, B$plot, ...)
}

Так что теперь вы можете просто сделать:

grid.arrange.equal(calHist, sodHist, ncol=2)

Данные в вашем примере немного коротки, чтобы дать хорошие гистограммы, но вы поняли:

enter image description here

с большим количеством реалистичных c фиктивных данных :

enter image description here

1 голос
/ 03 февраля 2020

Я бы go с гранями, как r2evans предлагает

za %>% 
  mutate(num = row_number()) %>% # add rownumbers to allow the pivoting
  pivot_longer(-num, names_to = "atom", values_to = "val") %>%
  ggplot(aes(x = val, col = atom, fill = atom)) +
  geom_histogram() +
  facet_wrap(~atom)
...