R+ggplot2+facet_wrap：保留条形图

Question

Please have a look at the reprex at the end of the post. It is a faceted barchart where the bars are placed in decreasing order in each subplot. My only question is how to ensure that the bars have the same consistent width in all the subplots.

I had a look at

How to automatically adjust the width of each facet for facet_wrap?

Equal bar width across facet_wrap barplots

but I did not go very far.

Any suggestion is appreciated!

library(tidyverse)


sec_ms_tcf_plot <- structure(list(member_state = c("BG", "EE", "EE", "HR", "HR", 
"HR", "HR", "HR", "HR", "HR", "LT", "LT", "LT", "LT", "LT", "LT", 
"LT", "LT", "MT", "MT", "MT", "PL", "PL", "PL", "PL", "PL", "PL", 
"PL", "PL", "PL", "PL", "PL", "PL", "PL", "PL", "PL", "PL", "RO", 
"RO", "RO", "RO", "RO", "RO", "RO", "RO", "RO", "RO", "RO", "RO", 
"RO", "RO", "RO", "RO", "RO", "RO", "SE", "SE", "SK", "SK", "SK", 
"SK", "SK", "SK", "SK", "SK", "SK", "SK", "SK", "SK", "SK", "SK", 
"SK", "SK", "SK", "SK"), sector = c("a_agriculture_forestry_and_fishing", 
"c_manufacturing", "a_agriculture_forestry_and_fishing", "b_mining_and_quarrying", 
"d_electricity_gas_steam_and_air_conditioning_supply", "a_agriculture_forestry_and_fishing", 
"g_wholesale_and_retail_trade_repair_of_motor_vehicles_and_motorcycles", 
"f_construction", "h_transportation_and_storage", "c_manufacturing", 
"i_accommodation_and_food_service_activities", "l_real_estate_activities", 
"h_transportation_and_storage", "e_water_supply_sewerage_waste_management_and_remediation_activities", 
"g_wholesale_and_retail_trade_repair_of_motor_vehicles_and_motorcycles", 
"d_electricity_gas_steam_and_air_conditioning_supply", "a_agriculture_forestry_and_fishing", 
"c_manufacturing", "a_agriculture_forestry_and_fishing", "h_transportation_and_storage", 
"c_manufacturing", "q_human_health_and_social_work_activities", 
"b_mining_and_quarrying", "l_real_estate_activities", "i_accommodation_and_food_service_activities", 
"s_other_service_activities", "e_water_supply_sewerage_waste_management_and_remediation_activities", 
"j_information_and_communication", "k_financial_and_insurance_activities", 
"m_professional_scientific_and_technical_activities", "h_transportation_and_storage", 
"n_administrative_and_support_service_activities", "d_electricity_gas_steam_and_air_conditioning_supply", 
"f_construction", "g_wholesale_and_retail_trade_repair_of_motor_vehicles_and_motorcycles", 
"c_manufacturing", "a_agriculture_forestry_and_fishing", "p_education", 
"k_financial_and_insurance_activities", "o_public_administration_and_defence_compulsory_social_security", 
"r_arts_entertainment_and_recreation", "s_other_service_activities", 
"b_mining_and_quarrying", "d_electricity_gas_steam_and_air_conditioning_supply", 
"q_human_health_and_social_work_activities", "e_water_supply_sewerage_waste_management_and_remediation_activities", 
"m_professional_scientific_and_technical_activities", "n_administrative_and_support_service_activities", 
"j_information_and_communication", "i_accommodation_and_food_service_activities", 
"a_agriculture_forestry_and_fishing", "h_transportation_and_storage", 
"f_construction", "c_manufacturing", "g_wholesale_and_retail_trade_repair_of_motor_vehicles_and_motorcycles", 
"a_agriculture_forestry_and_fishing", "d_electricity_gas_steam_and_air_conditioning_supply", 
"p_education", "n_administrative_and_support_service_activities", 
"s_other_service_activities", "j_information_and_communication", 
"m_professional_scientific_and_technical_activities", "o_public_administration_and_defence_compulsory_social_security", 
"f_construction", "r_arts_entertainment_and_recreation", "e_water_supply_sewerage_waste_management_and_remediation_activities", 
"b_mining_and_quarrying", "d_electricity_gas_steam_and_air_conditioning_supply", 
"h_transportation_and_storage", "q_human_health_and_social_work_activities", 
"i_accommodation_and_food_service_activities", "g_wholesale_and_retail_trade_repair_of_motor_vehicles_and_motorcycles", 
"l_real_estate_activities", "a_agriculture_forestry_and_fishing", 
"c_manufacturing"), sector_exp = c(217483, 2374, 3730, 31, 1217, 
1563, 3637, 5181, 5294, 33715, 8, 93, 271, 750, 857, 3180, 32106, 
43777, 715, 759, 14230, 129, 143, 224, 265, 383, 1016, 1569, 
1763, 2254, 2309, 2507, 5307, 15428, 38174, 38189, 558519, 416, 
673, 2194, 2726, 3381, 6841, 9425, 10731, 16835, 18968, 20845, 
23340, 43572, 170800, 175884, 205434, 272582, 892678, 149629, 
149629, 75, 466, 498, 607, 679, 918, 919, 1014, 1037, 1130, 1521, 
1635, 1639, 1837, 3715, 5275, 11874, 51306), sector_code = c("A", 
"C", "A", "B", "D", "A", "G", "F", "H", "C", "I", "L", "H", "E", 
"G", "D", "A", "C", "A", "H", "C", "Q", "B", "L", "I", "S", "E", 
"J", "K", "M", "H", "N", "D", "F", "G", "C", "A", "P", "K", "O", 
"R", "S", "B", "D", "Q", "E", "M", "N", "J", "I", "A", "H", "F", 
"C", "G", "A", "D", "P", "N", "S", "J", "M", "O", "F", "R", "E", 
"B", "D", "H", "Q", "I", "G", "L", "A", "C")), row.names = c(NA, 
-75L), class = c("tbl_df", "tbl", "data.frame"))
 


## See https://stackoverflow.com/questions/5409776/how-to-order-bars-in-faceted-ggplot2-bar-chart/5414445#5414445


dd2 <- sec_ms_tcf_plot |>
    mutate(category2=factor(paste(member_state, sector_code))) |>
    mutate(category2=reorder(category2, rank(sector_exp)))


gpl <- ggplot(dd2, aes(y=category2, x=sector_exp/1e3)) +
  geom_bar(stat = "identity") +
  facet_wrap(. ~ member_state, scales = "free_y", nrow=3) +
    scale_y_discrete(labels=dd2$sector_code, breaks=dd2$category2,
                     )+
        xlab("Sector Expenditure (Mio \u20ac)")+
    ylab("Sector NACE Code")


ggsave( "expenditure.png", gpl, width=10, height=13)



##Is there any way to have the same bar width in all the subplots?

^{Created on 2023-05-26 with reprex v2.0.2}

Answer 1

This is not great but sort of does it.

It's tricky since ggplot bar widths are scaled in proportion to the number of categories in each facet, and you want those to vary. One hack would be to add blank categories into each facet to augment them so that every facet has as many categories as the most crowded facet.

pad_facets <- function(df, facet_var, cat_var) {
  df %>%
    distinct({{facet_var}}, {{cat_var}}) %>%            # keep 1 row per facet/cat
    count({{facet_var}}) %>%                            # how many cat per facet?
    transmute({{facet_var}}, cat_to_add = max(n) - n) %>% # calc # cat to add
    uncount(cat_to_add) %>%                               # copy each cat x times
    mutate({{cat_var}} := as_factor(row_number())) %>%  # add new factor level
    bind_rows(df)                                         # add on original data
}

dd2 %>%
  pad_facets(member_state, category2) %>%

ggplot(aes(y=category2, x=sector_exp/1e3)) +
  geom_bar(stat = "identity",
           position = position_dodge(preserve = "total")) +
  facet_wrap(. ~ member_state, scales = "free_y", nrow=3) +
  scale_y_discrete(labels=dd2$sector_code, breaks=dd2$category2,
  )+
  xlab("Sector Expenditure (Mio \u20ac)")+
  ylab("Sector NACE Code")