Ярлыки многострочной оси с вложенными переменными группировки

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

data <- read.table(text = "Group Category Value
    S1 A   73
    S2 A   57
    S1 B   7
    S2 B   23
    S1 C   51
    S2 C   87", header = TRUE)

ggplot(data = data, aes(x = Category, y = Value, fill = Group)) + 
  geom_bar(position = 'dodge') +
  geom_text(aes(label = paste(Value, "%")), 
            position = position_dodge(width = 0.9), vjust = -0.25)

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

Любые идеи?

Ответы

Ответ 1

Вы можете создать пользовательскую функцию элемента для axis.text.x.

library(ggplot2)
library(grid)

## create some data with asymmetric fill aes to generalize solution 
data <- read.table(text = "Group Category Value
                   S1 A   73
                   S2 A   57
                   S3 A   57
                   S4 A   57
                   S1 B   7
                   S2 B   23
                   S3 B   57
                   S1 C   51
                   S2 C   57
                   S3 C   87", header=TRUE)

# user-level interface 
axis.groups = function(groups) {
  structure(
    list(groups=groups),
    ## inheritance since it should be a element_text
    class = c("element_custom","element_blank")  
  )
}
# returns a gTree with two children: 
# the categories axis
# the groups axis
element_grob.element_custom <- function(element, x,...)  {
  cat <- list(...)[[1]]
  groups <- element$group
  ll <- by(data$Group,data$Category,I)
  tt <- as.numeric(x)
  grbs <- Map(function(z,t){
    labs <- ll[[z]]
    vp = viewport(
             x = unit(t,'native'), 
             height=unit(2,'line'),
             width=unit(diff(tt)[1],'native'),
             xscale=c(0,length(labs)))
    grid.rect(vp=vp)
    textGrob(labs,x= unit(seq_along(labs)-0.5,
                                'native'),
             y=unit(2,'line'),
             vp=vp)
  },cat,tt)
  g.X <- textGrob(cat, x=x)
  gTree(children=gList(do.call(gList,grbs),g.X), cl = "custom_axis")
}

## # gTrees don't know their size 
grobHeight.custom_axis = 
  heightDetails.custom_axis = function(x, ...)
  unit(3, "lines")

## the final plot call
ggplot(data=data, aes(x=Category, y=Value, fill=Group)) + 
  geom_bar(position = position_dodge(width=0.9),stat='identity') +
  geom_text(aes(label=paste(Value, "%")),
            position=position_dodge(width=0.9), vjust=-0.25)+
  theme(axis.text.x = axis.groups(unique(data$Group)),
        legend.position="none")

Ответ 2

Аргумент strip.position в facet_wrap() и аргумент switch в facet_grid(), начиная с ggplot2 2.2.0, теперь упрощают создание простой версии этого графика с помощью фасетирования. Чтобы придать сюжету непрерывный вид, установите panel.spacing на 0.

Вот пример использования набора данных с другим количеством групп на категорию из ответа @agtudy.

Я использовал scales = "free_x", чтобы удалить лишнюю группу из категорий, в которых ее нет, хотя это не всегда желательно.
Аргумент strip.position = "bottom" перемещает метки фасетов вниз. Я удалил фон полосы вместе с strip.background, но я мог видеть, что в некоторых ситуациях полезно оставить прямоangularьник полосы.
Я использовал width = 1, чтобы полосы в каждой категории касались друг друга - по умолчанию между ними будут пробелы.

Я также использую strip.placement и strip.background в theme, чтобы получить полосы снизу и удалить прямоangularьник полосы.

Код для версий ggplot2_2.2.0 или новее:

ggplot(data = data, aes(x = Group, y = Value, fill = Group)) + 
    geom_bar(stat = "identity", width = 1) +
    geom_text(aes(label = paste(Value, "%")), vjust = -0.25) +
    facet_wrap(~Category, strip.position = "bottom", scales = "free_x") +
    theme(panel.spacing = unit(0, "lines"), 
         strip.background = element_blank(),
         strip.placement = "outside")

Вы можете использовать space= "free_x" в facet_grid(), если хотите, чтобы все полосы были одинаковой ширины независимо от количества групп в категории. Обратите внимание, что здесь используется switch = "x" вместо strip.position. Вы также можете изменить метку оси X; Я не был уверен, что это должно быть, может быть, Категория вместо группы?

ggplot(data = data, aes(x = Group, y = Value, fill = Group)) + 
    geom_bar(stat = "identity", width = 1) +
    geom_text(aes(label = paste(Value, "%")), vjust = -0.25) +
    facet_grid(~Category, switch = "x", scales = "free_x", space = "free_x") +
    theme(panel.spacing = unit(0, "lines"), 
         strip.background = element_blank(),
         strip.placement = "outside") + 
    xlab("Category")

Старые версии кода

Код для ggplot2_2.0.0, когда эта функция была впервые представлена, немного отличался. Я сохранил его ниже для потомков:

ggplot(data = data, aes(x = Group, y = Value, fill = Group)) + 
    geom_bar(stat = "identity") +
    geom_text(aes(label = paste(Value, "%")), vjust = -0.25) +
    facet_wrap(~Category, switch = "x", scales = "free_x") +
    theme(panel.margin = unit(0, "lines"), 
         strip.background = element_blank())

Ответ 3

Альтернативой методу agstudy является редактирование gtable и вставка "оси", вычисленной ggplot2,

p <- ggplot(data=data, aes(x=Category, y=Value, fill=Group)) + 
  geom_bar(position = position_dodge(width=0.9),stat='identity') +
  geom_text(aes(label=paste(Value, "%")),
            position=position_dodge(width=0.9), vjust=-0.25)

axis <- ggplot(data=data, aes(x=Category, y=Value, colour=Group)) +
  geom_text(aes(label=Group, y=0),
            position=position_dodge(width=0.9))

annotation <- gtable_filter(ggplotGrob(axis), "panel", trim=TRUE)
annotation[["grobs"]][[1]][["children"]][c(1,3)] <- NULL #only keep textGrob

library(gtable)
g <- ggplotGrob(p)
gtable_add_grobs <- gtable_add_grob # let use this alias
g <- gtable_add_rows(g, unit(1,"line"), pos=4)
g <- gtable_add_grobs(g, annotation, t=5, b=5, l=4, r=4)
grid.newpage()
grid.draw(g)

Ответ 4

Очень простое решение, которое дает аналогичный (хотя и не идентичный) результат, заключается в использовании огранки. Недостатком является то, что метка категории выше, а не ниже.

ggplot(data=data, aes(x=Group, y=Value, fill=Group)) +
  geom_bar(position = 'dodge', stat="identity") +
  geom_text(aes(label=paste(Value, "%")), position=position_dodge(width=0.9), vjust=-0.25) + 
  facet_grid(. ~ Category) + 
  theme(legend.position="none")

Ответ 5

@agstudy уже ответил на этот вопрос, и я сам буду использовать его, но если вы примете что-то более уродливое, но проще, это то, с чем я пришел перед его ответом:

data <- read.table(text = "Group Category Value
    S1 A   73
    S2 A   57
    S1 B   7
    S2 B   23
    S1 C   51
    S2 C   87", header=TRUE)

p <- ggplot(data=data, aes(x=Category, y=Value, fill=Group))
p + geom_bar(position = 'dodge') +
  geom_text(aes(label=paste(Value, "%")), position=position_dodge(width=0.9),   vjust=-0.25) +
  geom_text(colour="darkgray", aes(y=-3, label=Group),  position=position_dodge(width=0.9), col=gray) +
  theme(legend.position = "none", 
    panel.background=element_blank(),
    axis.line = element_line(colour = "black"),
    axis.line.x = element_line(colour = "white"),
    axis.ticks.x = element_blank(),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    panel.border = element_blank(),
    panel.background = element_blank()) +
  annotate("segment", x = 0, xend = Inf, y = 0, yend = 0)

Что даст нам:

Ответ 6

Вот еще одно решение с использованием пакета, над которым я работаю для сгруппированных гистограмм (ggNestedBarChart):

data <- read.table(text = "Group Category Value
                   S1 A   73
                   S2 A   57
                   S3 A   57
                   S4 A   57
                   S1 B   7
                   S2 B   23
                   S3 B   57
                   S1 C   51
                   S2 C   57
                   S3 C   87", header = TRUE)

devtools::install_github("davedgd/ggNestedBarChart")
library(ggNestedBarChart)
library(scales)

p1 <- ggplot(data, aes(x = Category, y = Value/100, fill = Category), stat = "identity") +
  geom_bar(stat = "identity") +
  facet_wrap(vars(Category, Group), strip.position = "top", scales = "free_x", nrow = 1) +
  theme_bw(base_size = 13) +
  theme(panel.spacing = unit(0, "lines"),
        strip.background = element_rect(color = "black", size = 0, fill = "grey92"),
        strip.placement = "outside",
        axis.text.x = element_blank(),
        axis.ticks.x = element_blank(),
        panel.grid.major.y = element_line(colour = "grey"),
        panel.grid.major.x = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_rect(color = "black", fill = NA, size = 0),
        panel.background = element_rect(fill = "white"),
        legend.position = "none") + 
  scale_y_continuous(expand = expand_scale(mult = c(0, .1)), labels = percent) + 
  geom_text(aes(label = paste0(Value, "%")), position = position_stack(0.5), color = "white", fontface = "bold")

ggNestedBarChart(p1)

ggsave("p1.png", width = 10, height = 5)

Обратите внимание, что ggNestedBarChart может группировать столько уровней, сколько необходимо, и не ограничивается только двумя (т.е. категория и Группа в этом примере). Например, используя данные (mtcars):

Код для этого примера находится на странице GitHub.