web-dev-qa-db-fra.com

Étiquettes d'axe à plusieurs lignes avec variables de regroupement imbriquées

J'aimerais que les niveaux de deux variables de regroupement imbriquées différentes apparaissent sur des lignes distinctes sous le tracé, et non dans la légende. Ce que j'ai en ce moment, c'est ce code:

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)

enter image description here

Ce que j'aimerais avoir, c'est quelque chose comme ceci:

enter image description here

Des idées?

35
pawels

Vous pouvez créer une fonction d'élément personnalisée pour axis.text.x.

enter image description here

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")
19
agstudy

L'argument strip.position Dans facet_wrap() et switch argument dans facet_grid() puisque ggplot2 2.2.0 fait maintenant la création d'une version simple de cette intrigue assez simple via le facettage. Pour donner au tracé l'aspect ininterrompu, définissez le panel.spacing Sur 0.

Voici l'exemple utilisant l'ensemble de données avec un nombre de groupes par catégorie différent de la réponse de @ agtudy.

  • J'ai utilisé scales = "free_x" Pour supprimer le groupe supplémentaire des catégories qui ne l'ont pas, bien que ce ne soit pas toujours souhaitable.
  • L'argument strip.position = "bottom" Déplace les étiquettes de facette vers le bas. J'ai supprimé l'arrière-plan de la bande avec strip.background, Mais je pouvais voir que laisser le rectangle de la bande serait utile dans certaines situations.
  • J'ai utilisé width = 1 Pour rendre les barres de chaque catégorie tactiles - elles auraient des espaces entre elles par défaut.

J'utilise également strip.placement Et strip.background Dans theme pour obtenir les bandes en bas et supprimer le rectangle de la bande.

Le code pour les versions de ggplot2_2.2.0 ou plus récent:

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

enter image description here

Vous pouvez utiliser space= "free_x" Dans facet_grid() si vous souhaitez que toutes les barres aient la même largeur quel que soit le nombre de groupes par catégorie. Notez que cela utilise switch = "x" Au lieu de strip.position. Vous pouvez également vouloir changer l'étiquette de l'axe des x; Je ne savais pas trop ce que cela devrait être, peut-être Catégorie au lieu de Groupe?

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

enter image description here

Versions de code plus anciennes

Le code de ggplot2_2.0.0, lorsque cette fonctionnalité a été introduite pour la première fois, était un peu différent. Je l'ai enregistré ci-dessous pour la postérité:

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())
46
aosmith

Une solution très simple qui donne un résultat similaire (mais pas identique) consiste à utiliser le facettage. L'inconvénient est que l'étiquette de catégorie est au-dessus plutôt qu'en dessous.

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

Using faceting to provide secondary label

7
AndrewMinCH

Une alternative à la méthode d'agstudy est d'éditer le gtable et d'insérer un "axe" calculé par 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's 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)

enter image description here

7
baptiste

@agstudy a déjà répondu à cette question et je vais l'utiliser moi-même, mais si vous acceptez quelque chose de plus laid, mais plus simple, voici ce que je suis venu avant sa réponse:

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)

Ce qui nous donnera:

enter image description here

4
pawels

Voici une autre solution utilisant un package sur lequel je travaille pour des graphiques à barres groupés ( 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)

example plot

Notez que ggNestedBarChart peut regrouper autant de niveaux que nécessaire et n'est pas limité à seulement deux (c'est-à-dire Catégorie et Groupe dans cet exemple). Par exemple, en utilisant des données (mtcars):

deep nesting/grouping

Le code de cet exemple se trouve sur la page GitHub.

1
davedgd