Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

stacked barplot with repel legend manipulate single labels e.g. in italics #264

Open
sofalbre opened this issue Oct 9, 2024 · 2 comments

Comments

@sofalbre
Copy link

sofalbre commented Oct 9, 2024

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
normal plot

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:

plotwithdirectllabels

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

@slowkow
Copy link
Owner

slowkow commented Oct 9, 2024

If you're in a rush, consider using a program like Illustrator to modify the text in a saved PDF file.

Mathematical expressions should also work, but I don't have time to look at your code right now. (Please consider sharing a minimal reproducible example, with only the minimum amount of code needed to demonstrate your issue, and nothing else.)

In the future, I'd like to support ggtext which should make this easier — something like "*italics* normal". Pull requests are welcome!

@sofalbre
Copy link
Author

sofalbre commented Oct 11, 2024 via email

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

2 participants