stacked barplot with repel legend manipulate single labels e.g. in italics #264
Description
Hello! So I would like to manipulate some labels I have added to a stacked bar plot through repel. The problem is, that some names will have to be in italics, while others don't so I am trying to specify each and I can not succeed so far.
I previously created this plot with the normal legend where it worked:
predictions <- predictions %>%
mutate(formatted_species = factor(
response.level,
levels = sort(unique(response.level)) # Sort species alphabetically
))
# manipulate labels
species_labels <- c(
"Eledone.cirrhosa" = expression(italic("E. cirrhosa")), # Italics
"Argentina.sp." = expression(italic("Argentina sp.")), # Italics
"Gadidae.UKN" = "Gadidae UKN", # Regular text
"Gobiidae.UKN" = "Gobiidae UKN", # Regular text
"Fish.UKN" = "Fish UKN", # Regular text
"Loligo.sp." = expression(italic("Loligo sp.")), # Italics
"M. merlangus" = expression(italic("M. merlangus")), # Italics
"M. poutassou" = expression(italic("M. poutassou")), # Italics
"M. aeglefinus" = expression(italic("M. aeglefinus")), # Italics
"Merluccius.merluccius" = expression(italic("M. merluccius")), # Italics
"Clupea.harengus" = expression(italic("C. harengus")), # Italics
"Alloteuthis.sp." = expression(italic("Alloteuthis sp.")), # Italics
"Sepiolidae.UKN" = "Sepiolidae UKN", # Regular text
"Sprattus.sprattus" = expression(italic("S. sprattus")), # Italics
"T. trachurus" = expression(italic("T. trachurus")), # Italics
"T. esmarkii" = expression(italic("T. esmarkii")), # Italics
"Teuthida.UKN" = "Teuthida UKN", # Regular text
"Todaropsis.eblanae" = expression(italic("T. eblanae")), # Italics
"Trisopterus.sp." = expression(italic("Trisopterus sp.")), # Italics
"Trisopterus.esmarkii" = expression(italic("T. esmarkii")), # Italics
"Merlangius.merlangus" = expression(italic("M. merlangus")) # Italics
)
#plot
g <- ggplot(predictions) +
aes(x = factor(x), y = predicted, fill = formatted_species) + # Use new formatted column
geom_bar(stat = "identity", position = "fill", color = "black") + # Stacked bar plot
scale_x_discrete(labels = c("IR.contemporary", "IR.historical")) + # Custom x-axis labels
labs(x = 'Sampling period', y = 'Proportion of predicted probabilities', fill = 'Species') + # Adjust labels
theme_classic(base_size = 22) +
ylim(c(0, 1)) +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_fill_manual(values = scales::hue_pal()(length(species_labels)), labels = species_labels) # Custom fill with labels and original colors
g
and I have this image
I have modified the code to have clear labels indicated with repel:
###function to stack the repels (thank you genius!!): https://github.com/slowkow/ggrepel/issues/161
position_stack_and_nudge <- function(x = 0, y = 0, vjust = 1, reverse = FALSE) {
ggproto(NULL, PositionStackAndNudge,
x = x,
y = y,
vjust = vjust,
reverse = reverse
)
}
#' @rdname ggplot2-ggproto
#' @format NULL
#' @usage NULL
#' @noRd
PositionStackAndNudge <- ggproto("PositionStackAndNudge", PositionStack,
x = 0,
y = 0,
setup_params = function(self, data) {
c(
list(x = self$x, y = self$y),
ggproto_parent(PositionStack, self)$setup_params(data)
)
},
compute_layer = function(self, data, params, panel) {
# operate on the stacked positions (updated in August 2020)
data = ggproto_parent(PositionStack, self)$compute_layer(data, params, panel)
x_orig <- data$x
y_orig <- data$y
# transform only the dimensions for which non-zero nudging is requested
if (any(params$x != 0)) {
if (any(params$y != 0)) {
data <- transform_position(data, function(x) x + params$x, function(y) y + params$y)
} else {
data <- transform_position(data, function(x) x + params$x, NULL)
}
} else if (any(params$y != 0)) {
data <- transform_position(data, function(x) x, function(y) y + params$y)
}
data$nudge_x <- data$x
data$nudge_y <- data$y
data$x <- x_orig
data$y <- y_orig
data
},
compute_panel = function(self, data, params, scales) {
ggproto_parent(PositionStack, self)$compute_panel(data, params, scales)
}
)
library(dplyr)
library(ggplot2)
library(ggrepel)
# Create dummy entries for spacing
dummy_row_1 <- data.frame(
x = 1.5, # Position for the first dummy row (between 1 and 2)
predicted = 0, # Height for the dummy bar
response.level = " " # Empty space to avoid NA
)
dummy_row_2 <- data.frame(
x = 3.5, # Position for the second dummy row (after the last bar)
predicted = 0, # Height for the dummy bar
response.level = " " # Empty space to avoid NA
)
# Combine the original predictions with the dummy rows
predictions_with_dummy <- bind_rows(predictions, dummy_row_1, dummy_row_2)
# Ensure the x factor levels include the dummies
predictions_with_dummy$x <- factor(predictions_with_dummy$x,
levels = c(1, 1.5, 2, 3.5), # Use 1.5 and 3.5 for spacing
labels = c("IR.contemporary", "", "IR.historical", "")) # Correct labels
# Plot
g <- ggplot(predictions_with_dummy) +
aes(x = x, y = predicted, fill = response.level) + # Use factor for x-axis
geom_bar(stat = "identity", position = "fill", color = "black", width = 0.8) + # Adjust the bar width
labs(x = 'Sampling period', y = 'Proportion of predicted probabilities', fill = 'Species') + # Adjust labels
theme_classic(base_size = 22) +
ylim(c(0, 1)) +
# Expand scale to create more space on the right side
scale_x_discrete(expand = expansion(mult = c(0.3, 1.1))) + # Add space only on the right side
geom_text_repel(data = predictions_with_dummy[!predictions_with_dummy$response.level == " ", ], # Filter out the dummy rows
aes(label = response.level, color = response.level), size = 5,
segment.color = "grey50", # Color for the segments
position = position_stack_and_nudge(vjust = 0.5, y = 0, x = 0.5), direction="y", hjust=0,segment.curvature = 0,segment.ncp = 10,
box.padding = 0, max.overlaps = Inf) +
theme(legend.position = "none") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
theme(axis.ticks.x = element_blank())
g
Which leads to this plot that I am in general quite happy with:
I am not unfortunately not able to edit the species labels in the same way as before... any advise how I could achieve what I would like? predict is the result of ggeffect function on my model. Even if I change the original names already before the modelling I would need to manipulate some in italics and some not, so not sure if that would be helpful at all... Any advise would be much appreciated.
I have for example tried, or putting the case when or an ielse directly into the repel but it didnt run either way.
predictions_with_dummy <- predictions_with_dummy %>%
mutate(formatted_labels = case_when(
response.level == "Eledone.cirrhosa" ~ expression(italic("E. cirrhosa")),
response.level == "Argentina.sp." ~ expression(italic("Argentina sp.")),
response.level == "Gadidae.UKN" ~ "Gadidae UKN",
response.level == "Gobiidae.UKN" ~ "Gobiidae UKN",
response.level == "Fish.UKN" ~ "Fish UKN",
response.level == "Loligo.sp." ~ expression(italic("Loligo sp.")),
response.level == "M. merlangus" ~ expression(italic("M. merlangus")),
response.level == "M. poutassou" ~ expression(italic("M. poutassou")),
response.level == "M. aeglefinus" ~ expression(italic("M. aeglefinus")),
response.level == "Merluccius.merluccius" ~ expression(italic("M. merluccius")),
response.level == "Clupea.harengus" ~ expression(italic("C. harengus")),
response.level == "Alloteuthis.sp." ~ expression(italic("Alloteuthis sp.")),
response.level == "Sepiolidae.UKN" ~ "Sepiolidae UKN",
response.level == "Sprattus.sprattus" ~ expression(italic("S. sprattus")),
response.level == "T. trachurus" ~ expression(italic("T. trachurus")),
response.level == "T. esmarkii" ~ expression(italic("T. esmarkii")),
response.level == "Teuthida.UKN" ~ "Teuthida UKN",
response.level == "Todaropsis.eblanae" ~ expression(italic("T. eblanae")),
response.level == "Trisopterus.sp." ~ expression(italic("Trisopterus sp.")),
response.level == "Trisopterus.esmarkii" ~ expression(italic("T. esmarkii")),
TRUE ~ response.level # Default case if none of the above match
))
# plot
g <- ggplot(predictions_with_dummy) +
aes(x = x, y = predicted, fill = response.level) +
geom_bar(stat = "identity", position = "fill", color = "black", width = 0.8) +
labs(x = 'Sampling period', y = 'Proportion of predicted probabilities', fill = 'Species') +
theme_classic(base_size = 22) +
ylim(c(0, 1)) +
scale_x_discrete(expand = expansion(mult = c(0.3, 1.1))) +
# formatted labels in geom_text_repel
geom_text_repel(data = predictions_with_dummy[!predictions_with_dummy$response.level == " ", ],
aes(label = formatted_labels), size = 5,
segment.color = "grey50",
position = position_stack_and_nudge(vjust = 0.5, y = 0, x = 0.5),
direction = "y", hjust = 0, segment.curvature = 0, segment.ncp = 10,
box.padding = 0, max.overlaps = Inf) +
theme(legend.position = "none") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
theme(axis.ticks.x = element_blank()) +
scale_fill_manual(values = scales::hue_pal()(length(unique(predictions_with_dummy$response.level))))
this one did not work neither:
g <- ggplot(predictions_with_dummy) +
aes(x = x, y = predicted, fill = response.level) + # Use response.level for fill
geom_bar(stat = "identity", position = "fill", color = "black", width = 0.8) + # Adjust the bar width
labs(x = 'Sampling period', y = 'Proportion of predicted probabilities', fill = 'Species') + # Adjust labels
theme_classic(base_size = 22) +
ylim(c(0, 1)) +
# Expand scale to create more space on the right side
scale_x_discrete(expand = expansion(mult = c(0.3, 1.1))) +
geom_text_repel(data = predictions_with_dummy[!predictions_with_dummy$response.level == " ", ], # Filter out the dummy rows
aes(
label = case_when(
response.level == "Eledone.cirrhosa" ~ expression(italic("E. cirrhosa")),
response.level == "Argentina.sp." ~ expression(italic("Argentina sp.")),
response.level == "Gadidae.UKN" ~ "Gadidae UKN",
response.level == "Gobiidae.UKN" ~ "Gobiidae UKN",
response.level == "Fish.UKN" ~ "Fish UKN",
response.level == "Loligo.sp." ~ expression(italic("Loligo sp.")),
response.level == "M. merlangus" ~ expression(italic("M. merlangus")),
response.level == "M. poutassou" ~ expression(italic("M. poutassou")),
response.level == "M. aeglefinus" ~ expression(italic("M. aeglefinus")),
response.level == "Merluccius.merluccius" ~ expression(italic("M. merluccius")),
response.level == "Clupea.harengus" ~ expression(italic("C. harengus")),
response.level == "Alloteuthis.sp." ~ expression(italic("Alloteuthis sp.")),
response.level == "Sepiolidae.UKN" ~ "Sepiolidae UKN",
response.level == "Sprattus.sprattus" ~ expression(italic("S. sprattus")),
response.level == "T. trachurus" ~ expression(italic("T. trachurus")),
response.level == "T. esmarkii" ~ expression(italic("T. esmarkii")),
response.level == "Teuthida.UKN" ~ "Teuthida UKN",
response.level == "Todaropsis.eblanae" ~ expression(italic("T. eblanae")),
response.level == "Trisopterus.sp." ~ expression(italic("Trisopterus sp.")),
TRUE ~ response.level # Default case for any other levels
)
),
size = 5,
segment.color = "grey50", # Color for the segments
position = position_stack_and_nudge(vjust = 0.5, y = 0, x = 0.5),
direction="y", hjust=0, segment.curvature = 0, segment.ncp = 10,
box.padding = 0, max.overlaps = Inf
) +
theme(legend.position = "none") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
theme(axis.ticks.x = element_blank()) +
scale_fill_manual(values = scales::hue_pal()(length(unique(predictions_with_dummy$response.level)))) # Use the original color palette
g
predictions would look like:
dput(predictions)
structure(list(x = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
2, 2, 2, 2, 2), predicted = c(0.00346765946431063, 0.0253006784802539,
0.00996429315469765, 0.11818939096279, 0.0187208625272109, 0.0211578581239299,
0.0166134186519834, 0.419634728462347, 0.0594968082789304, 0.173688828121586,
2.48311604482499e-05, 0.00392479550225181, 0.00673403374035583,
0.032324891612091, 0.00783371889201961, 4.65453177468661e-05,
2.34819092133031e-05, 4.62975512201524e-05, 1.74787489722494e-06,
0.0828051302117163, 0.000393703313081224, 0.0143522708149105,
0.0126459538519946, 0.000134307916708042, 0.0308081207014834,
4.70586119587709e-06, 0.01203074223696, 0.713903150506441, 0.00241769426327644,
0.0322541735970322, 9.95537535203168e-05, 0.0276224061323732,
0.000277793521964922, 0.0470972742508751, 0.0178147466657041,
1.49485513384722e-05, 0.000820741632441746, 0.0494941055141075,
0.000175689203373736, 0.0376379177112181), response.level = c("Eledone.cirrhosa",
"Merluccius.merluccius", "Clupea.harengus", "Trisopterus.esmarkii",
"Sprattus.sprattus", "Teuthida.UKN", "Todaropsis.eblanae", "Trisopterus.sp.",
"Gobiidae.UKN", "Merlangius.merlangus", "Loligo.sp.", "Fish.UKN",
"Trachurus.trachurus", "Gadidae.UKN", "Micromesistius.poutassou",
"Melanogrammus.aeglefinus", "Argentina.sp.", "Sepiolidae.UKN",
"Alloteuthis.sp.", "Other", "Eledone.cirrhosa", "Merluccius.merluccius",
"Clupea.harengus", "Trisopterus.esmarkii", "Sprattus.sprattus",
"Teuthida.UKN", "Todaropsis.eblanae", "Trisopterus.sp.", "Gobiidae.UKN",
"Merlangius.merlangus", "Loligo.sp.", "Fish.UKN", "Trachurus.trachurus",
"Gadidae.UKN", "Micromesistius.poutassou", "Melanogrammus.aeglefinus",
"Argentina.sp.", "Sepiolidae.UKN", "Alloteuthis.sp.", "Other"
), group = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), levels = "1", class = "factor"),
y_position = c(0.00173382973215531, 0.0161179987044376, 0.0337504845219133,
0.097827326580657, 0.166282453325657, 0.186221813651228,
0.205107452039184, 0.42323152559635, 0.662797293966988, 0.779390112167247,
0.866246941808264, 0.868221755139614, 0.873551169760918,
0.893080632437141, 0.913159937689196, 0.917100069794079,
0.91713508340756, 0.917169973137776, 0.917193995850835, 0.958597434894142,
0.000196851656540612, 0.00756983872053646, 0.021068951053989,
0.0274590819383403, 0.0429302962474361, 0.0583367095287757,
0.0643544335778536, 0.427321379949554, 0.785481802334412,
0.802817736264567, 0.818994599939843, 0.83285557988279, 0.846805679709959,
0.870493213596379, 0.902949224054668, 0.91186407166319, 0.91228191675508,
0.937439340328355, 0.962274237687095, 0.981181041144391),
cumulative = c(0.00346765946431063, 0.0287683379445645, 0.0387326310992622,
0.156922022062052, 0.175642884589263, 0.196800742713193,
0.213414161365176, 0.633048889827523, 0.692545698106454,
0.86623452622804, 0.866259357388488, 0.87018415289074, 0.876918186631096,
0.909243078243187, 0.917076797135206, 0.917123342452953,
0.917146824362166, 0.917193121913386, 0.917194869788284,
1, 0.000393703313081224, 0.0147459741279917, 0.0273919279799863,
0.0275262358966944, 0.0583343565981777, 0.0583390624593736,
0.0703698046963336, 0.784272955202774, 0.786690649466051,
0.818944823063083, 0.819044376816603, 0.846666782948976,
0.846944576470941, 0.894041850721816, 0.91185659738752, 0.911871545938859,
0.912692287571301, 0.962186393085408, 0.962362082288782,
1), formatted_species = structure(c(4L, 11L, 3L, 19L, 15L,
16L, 17L, 20L, 7L, 10L, 8L, 5L, 18L, 6L, 12L, 9L, 2L, 14L,
1L, 13L, 4L, 11L, 3L, 19L, 15L, 16L, 17L, 20L, 7L, 10L, 8L,
5L, 18L, 6L, 12L, 9L, 2L, 14L, 1L, 13L), levels = c("Alloteuthis.sp.",
"Argentina.sp.", "Clupea.harengus", "Eledone.cirrhosa", "Fish.UKN",
"Gadidae.UKN", "Gobiidae.UKN", "Loligo.sp.", "Melanogrammus.aeglefinus",
"Merlangius.merlangus", "Merluccius.merluccius", "Micromesistius.poutassou",
"Other", "Sepiolidae.UKN", "Sprattus.sprattus", "Teuthida.UKN",
"Todaropsis.eblanae", "Trachurus.trachurus", "Trisopterus.esmarkii",
"Trisopterus.sp."), class = "factor")), class = c("grouped_df",
"tbl_df", "tbl", "data.frame"), row.names = c(NA, -40L), groups = structure(list(
x = c(1, 2), .rows = structure(list(1:20, 21:40), ptype = integer(0), class = c("vctrs_list_of",
"vctrs_vctr", "list"))), class = c("tbl_df", "tbl", "data.frame"
), row.names = c(NA, -2L), .drop = TRUE))
question also posted here: https://stackoverflow.com/questions/79071007/stacked-barplot-with-repel-legend-manipulate-single-labels-e-g-in-italics
sorry for the spam, I am a stressed PhD student... X_x xoxo