Facet-specific ordering for stacked bar chart

tidyverse
,
1

Hi all,

I am attempting to create a simple stacked bar chart with facets where the groups/bars within a facet are of differing order based on bar height (sum of scores descending). After far too long searching for solutions this specific problem and trying a multitude of approaches, I seem to be at a dead end.

The example below is a minimal example to illustrate the problem. The order of the bars in "Team B" should be "Score B" first, then "Score A".

Note: My actual data does not have the same set of categories represented in each facet, but I did not introduce that here for simplicity.

Thanks!

library(tidyverse)

facet_group <- c("Team A", "Team A",
                 "Team A", "Team A",
                 "Team B", "Team B",
                 "Team B", "Team B")

in_facet_order_score_type <- c("Score A", "Score B",
                               "Score A", "Score B",
                               "Score A", "Score B",
                               "Score A", "Score B")

score_type_for_fill <-c(rep("humor", 2),
                        rep("voice", 2),
                        rep("humor", 2),
                        rep("voice", 2))

score <- c(5, 4,
           2, 1,
           1, 3,
           4, 6)

# Create the tbl from the vectors
scores_data <- tbl_df(data.frame(facet_group, in_facet_order_score_type, score_type_for_fill, score))

# calculate a total_score for facet-specific ordering 
scores_total <- group_by(scores_data, facet_group,in_facet_order_score_type) %>%
                summarise(total_score = sum(score)) %>%
                ungroup(scores_data)

scores_data <- left_join(scores_data,
                         scores_total,
                         by = c("facet_group", "in_facet_order_score_type"))  %>%
               arrange(facet_group, desc(total_score))

scores_data
#> # A tibble: 8 x 5
#>   facet_group in_facet_order_score_ty… score_type_for_fi… score total_score
#>   <fct>       <fct>                    <fct>              <dbl>       <dbl>
#> 1 Team A      Score A                  humor                  5           7
#> 2 Team A      Score A                  voice                  2           7
#> 3 Team A      Score B                  humor                  4           5
#> 4 Team A      Score B                  voice                  1           5
#> 5 Team B      Score B                  humor                  3           9
#> 6 Team B      Score B                  voice                  6           9
#> 7 Team B      Score A                  humor                  1           5
#> 8 Team B      Score A                  voice                  4           5


base_plot <-  ggplot(data = scores_data,
                     mapping = aes(x = in_facet_order_score_type,
                                   y = score,
                                   fill = score_type_for_fill,
                                   group = facet_group)
              ) 
  # add the bar layer
b <- base_plot +
     labs(title ="Geom Bar") +
     geom_bar(stat="identity")

b <- b + 
     facet_grid( ~ facet_group,  space  = "free", scales = "free", drop = TRUE, shrink = TRUE)  

b

Created on 2019-09-22 by the reprex package (v0.3.0)

2

Here is a solution inspired by

library(dplyr)
library(ggplot2)
facet_group <- c("Team A", "Team A",
                 "Team A", "Team A",
                 "Team B", "Team B",
                 "Team B", "Team B")

in_facet_order_score_type <- c("Score A", "Score B",
                               "Score A", "Score B",
                               "Score A", "Score B",
                               "Score A", "Score B")

score_type_for_fill <-c(rep("humor", 2),
                        rep("voice", 2),
                        rep("humor", 2),
                        rep("voice", 2))

score <- c(5, 4,
           2, 1,
           1, 3,
           4, 6)

# Create the tbl from the vectors
scores_data <- tbl_df(data.frame(facet_group, in_facet_order_score_type, score_type_for_fill, score))

# calculate a total_score for facet-specific ordering 
scores_total <- group_by(scores_data, facet_group,in_facet_order_score_type) %>%
  summarise(total_score = sum(score)) %>%
  ungroup(scores_data)

scores_data <- left_join(scores_data,
                         scores_total,
                         by = c("facet_group", "in_facet_order_score_type"))  %>%
  arrange(facet_group, desc(total_score))  

Ordered <- unique(select(scores_data, facet_group, in_facet_order_score_type, total_score)) %>%   
  mutate(Order = row_number()) %>% 
  select(facet_group, in_facet_order_score_type, Order)

scores_data <- inner_join(scores_data, Ordered)
#> Joining, by = c("facet_group", "in_facet_order_score_type")

scores_data
#> # A tibble: 8 x 6
#>   facet_group in_facet_order_sco~ score_type_for_~ score total_score Order
#>   <fct>       <fct>               <fct>            <dbl>       <dbl> <int>
#> 1 Team A      Score A             humor                5           7     1
#> 2 Team A      Score A             voice                2           7     1
#> 3 Team A      Score B             humor                4           5     2
#> 4 Team A      Score B             voice                1           5     2
#> 5 Team B      Score B             humor                3           9     3
#> 6 Team B      Score B             voice                6           9     3
#> 7 Team B      Score A             humor                1           5     4
#> 8 Team B      Score A             voice                4           5     4

base_plot <-  ggplot(data = scores_data,
                     mapping = aes(x = Order,  #in_facet_order_score_type,
                                   y = score,
                                   fill = score_type_for_fill,
                                   group = facet_group) 
)
# add the bar layer
b <- base_plot +
  labs(title ="Geom Bar") +
  geom_bar(stat="identity")
  

b <- b + 
  facet_grid( ~ facet_group,  space  = "free", scales = "free", 
              drop = TRUE, shrink = TRUE) +
  scale_x_continuous(breaks = Ordered$Order, 
                     labels = Ordered$in_facet_order_score_type)

b

Created on 2019-09-22 by the reprex package (v0.2.1)

I did not set the numbering of Order reset to 1 with each change of the facet_group because that caused problems when combined with the bar stacking.

2 Likes
3

This is another option using reorder_within() a function originally wrote it by David Robinson and now included in the tidytext package.

library(tidyverse)
library(tidytext)

scores_data <- data.frame(
    score = c(5, 2, 4, 1, 3, 6, 1, 4),
    total_score = c(7, 7, 5, 5, 9, 9, 5, 5),
    facet_group = as.factor(c("Team A", "Team A", "Team A",
                              "Team A", "Team B", "Team B",
                              "Team B", "Team B")),
    in_facet_order_score_type = as.factor(c("Score A", "Score A", "Score B",
                                            "Score B", "Score B", "Score B",
                                            "Score A", "Score A")),
    score_type_for_fill = as.factor(c("humor", "voice", "humor", "voice",
                                      "humor", "voice", "humor",
                                      "voice"))
)

scores_data %>% 
    ggplot(aes(x = reorder_within(in_facet_order_score_type, desc(score), facet_group),
               y = score,
               fill = score_type_for_fill)) +
    geom_col() + 
    labs(title ="Geom Bar", 
         x = "Order") +
    scale_x_reordered() +
    facet_grid( ~ facet_group,  space  = "free", scales = "free", drop = TRUE, shrink = TRUE)

2 Likes
5

Fantastic! Thank you so much for both of these!

7

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.