rggplot2visualizationpatchworklikert
Fine control over positioning of the Legend in a combined graph using ggplot
I'm pretty new to R and so far have successfully managed to solve all issues I encountered using a combination of stackoverflow, manuals, Google and ChatGPT. So before I start I have to say a big THANK YOU for all the questions that have been answered here before!
I'm trying to visualize data from a bipolar 7-point likert scale. The neutrals are plotted into a seperate graph and the two graphs are later combined. The legend is color-coded to the color of the bars it corresponds to and is shown above the graph, just below the title.
My problem is, that I cannot manage to get all of the legend displayed, especially not in the ideal positions i'd like them to be in. My favorite solution would be to have the nonneutral legend items centered across the width of the y-axis labels and the p1 graph (nonneutral data). The neutral legend should be centered above the p2 graph (neutral data). If this is too complicated / not possible, I'd be happy with the backup solution to just have all the legend items centered above the whole plot (y-axis labels + p1 + p2).
Reproducible Example:
library(tidyverse)
library(dplyr)
library(ggplot2)
library(patchwork)
library(ggtext)
library(RColorBrewer)
## Create sample data
neutral_data <- data.frame(
Category = c(
"CME-Punkte sammeln",
"Wissen aktuell halten",
"Weiterbildung in spez. Fachbereichen",
"Alternative zu Praesenzveranstaltungen",
"Erlernen fachlicher Grundlagen"
),
Response = rep(4, 5),
Count = c(8, 3, 7, 14, 5),
Total = rep(101, 5),
Percentage = c(7.92, 2.97, 6.93, 13.86, 4.95),
Code = rep("Neutral", 5)
)
nonneutral_data <- data.frame(
Category = rep(c(
"CME-Punkte sammeln",
"Wissen aktuell halten",
"Weiterbildung in spez. Fachbereichen",
"Alternative zu Praesenzveranstaltungen",
"Erlernen fachlicher Grundlagen"
), times = c(6, 3, 5, 5, 5)),
Response = c(
1, 2, 3, 5, 6, 7,
5, 6, 7,
1, 3, 5, 6, 7,
2, 3, 5, 6, 7,
2, 3, 5, 6, 7
),
Count = c(
1, 3, 2, 11, 23, 53,
7, 29, 62,
1, 1, 12, 42, 37,
5, 12, 18, 24, 27,
3, 4, 12, 28, 49
),
Total = rep(101, 24), # Total respondents per category
Percentage = c(
0.99, 2.97, 1.98, 10.89, 22.70, 52.47,
6.93, 28.71, 61.38,
0.99, 0.99, 11.88, 41.58, 37.62,
4.95, 11.88, 18.81, 23.76, 26.73,
2.97, 3.96, 11.88, 27.72, 48.51
),
Code = as.character(c(
1, 2, 3, 5, 6, 7,
5, 6, 7,
1, 3, 5, 6, 7,
2, 3, 5, 6, 7,
2, 3, 5, 6, 7
)),
Label = c(
"", "", "", "10.9%", "22.8%", "52.5%",
"6.9%", "28.7%", "61.4%",
"", "", "11.9%", "41.6%", "37.6%",
"", "11.9%", "18.8%", "23.8%", "26.7%",
"", "", "11.9%", "27.7%", "48.5%"
)
)
## Naming the columns & Setting order
column_names <- c(
"Erlernen fachlicher Grundlagen",
"Alternative zu Praesenzveranstaltungen",
"Weiterbildung in spez. Fachbereichen",
"Wissen aktuell halten",
"CME-Punkte sammeln"
)
## Define Legend Labels
labels <- c(
"1" = "Auf keinen Fall",
"2" = "Wahrscheinlich nicht",
"3" = "Eher nicht",
"Neutral" = "Unentschlossen",
"5" = "Eher ja",
"6" = "Wahrscheinlich ja",
"7" = "Auf jeden Fall"
)
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# Color and Label Setup
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
brewer_colors <- brewer.pal(n = 7, name = "RdBu")
cols <- c(
"1" = brewer_colors[1],
"2" = brewer_colors[2],
"3" = brewer_colors[3],
"Neutral" = "#B4B4B4",
"5" = brewer_colors[5],
"6" = brewer_colors[6],
"7" = brewer_colors[7]
)
# Function to create formatted legend labels
custom_labels <- function(labels, colors) {
sapply(names(labels), function(i) {
paste0("<span style='color:", colors[i], ";'>", labels[i], "</span>")
})
}
# Create one formatted label set for all values (1-7 + Neutral)
formatted_labels <- custom_labels(labels, cols)
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# Calculate Plot Dimensions
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
stacked_sums <- nonneutral_data %>%
group_by(Category) %>%
summarise(
LeftSum = sum(Percentage[Code %in% c("1", "2", "3")]),
RightSum = sum(Percentage[Code %in% c("5", "6", "7")])
) %>%
ungroup()
max_left_stack <- max(stacked_sums$LeftSum)
max_right_stack <- max(stacked_sums$RightSum)
max_neutral <- max(neutral_data$Percentage)
x_left <- max(ceiling(max_left_stack / 10) * 10, 15)
x_right <- max(ceiling(max_right_stack / 10) * 10, 15)
x_neutral <- max(ceiling(max_neutral / 5) * 5, 12.5)
x_left <- min(x_left, 100)
x_right <- min(x_right, 100)
x_neutral <- min(x_neutral, 100)
width_ratio <- (x_left + x_right) / max(x_neutral, 12.5)
x_breaks <- unique(sort(c(
-10, 10,
seq(-ceiling(x_left / 10) * 10, ceiling(x_right / 10) * 10, by = 20)
)))
hjust_values <- sapply(x_breaks, function(x) {
if (x == min(x_breaks, na.rm = TRUE)) {
0
} else if (x == max(x_breaks, na.rm = TRUE)) {
1
} else {
0.5
}
})
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# Create Plots
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
p1 <- ggplot(nonneutral_data,
aes(x = ifelse(Code %in% c("1", "2", "3"), -Percentage, Percentage),
y = factor(Category, levels = rev(column_names)), # Force the correct order
fill = factor(Code, levels = c("3", "2", "1", "5", "6", "7")))) +
geom_col(position = position_stack(reverse = TRUE)) +
geom_text(aes(label = Label),
position = position_stack(vjust = 0.5, reverse = TRUE),
size = 2.5) + #Reduced Text Size
scale_fill_manual(
values = cols,
labels = formatted_labels
) +
guides(fill = guide_legend(title = NULL,
nrow = 1,
byrow = FALSE,
override.aes = list(fill = NA, size = 0))) +
scale_x_continuous(breaks = x_breaks,
labels = ~paste0(abs(.x), "%"),
limits = c(-x_left, x_right),
expand = c(0, 0)) +
geom_vline(xintercept = 0,
linetype = "solid",
linewidth = 1.5,
color = "grey30") +
theme_bw() +
theme(
panel.grid.major.y = element_blank(),
legend.text = element_markdown(size = 8, face = "bold"),
legend.box.just = "left",
legend.justification = "left",
legend.position = "top",
axis.title = element_blank(),
axis.text = element_markdown(),
axis.text.x = element_markdown(hjust = hjust_values),
axis.text.y = element_markdown(),
axis.ticks.y = element_line(),
panel.background = element_blank(),
plot.background = element_rect(fill = "transparent", color = NA),
legend.background = element_blank(),
) +
coord_fixed(ratio = 7)
p2 <- ggplot(neutral_data, aes(x = Percentage, y = Category, fill = Code)) +
geom_col() +
geom_text(data = neutral_data %>%
filter(Percentage >= 5),
aes(label = paste0(round(Percentage, 1), "%")),
position = position_stack(vjust = 0.5),
size = 2.5) +
geom_text(data = neutral_data %>%
filter(Percentage < 5),
aes(label = paste0(round(Percentage, 1), "%"),
x = Percentage + 1),
hjust = 0,
size = 2.5) + # Reduced text size
scale_fill_manual(
values = cols,
labels = formatted_labels
) +
guides(fill = guide_legend(title = NULL,
nrow = 1,
override.aes = list(fill = NA, size = 0))) +
scale_x_continuous(limits = c(0, x_neutral),
expand = c(0, 0),
labels = ~paste0(.x, "%")) +
theme_bw() +
theme(
panel.grid.major.y = element_blank(),
legend.text = element_markdown(size = 8, face = "bold"),
legend.justification = "left",
legend.position = "top",
axis.title = element_blank(),
axis.text = element_markdown(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
panel.background = element_blank(),
plot.background = element_rect(fill = "transparent", color = NA),
legend.background = element_blank()
) +
coord_fixed(ratio = 7)
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# Combine and Return Plots
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
plot_example <- (p1 | p2) +
plot_layout(
guides = "keep",
widths = c(1, 1 / width_ratio)
) +
plot_annotation(
title = "Plot Test",
theme = theme(
plot.title = element_text(
hjust = 0.5,
vjust = 1,
size = 12,
face = "bold"
),
plot.background = element_rect(fill = "transparent", color = NA),
legend.position = "top",
legend.justification = "left",
legend.box.just = "left"
)
)
ggsave(
filename = "plot_example.png",
plot = plot_example,
width = 9,
height = 9 * 0.4,
dpi = 150,
units = "in",
device = "png"
)
I've tried to adjust legend position and legend box in multiple ways but was unsuccessful to extend the legend box across the y-axis labels and to get all the labels to show correctly. It's been run on RStudio on Windows, R Version 4.4.2
Solution
As a first step put the legend text on top. Second, to stretch the legend to fill the available space you can use a "null" unit for the legend.key.width (a feature introduced in ggplot2 3.5.0, see here). Additionally as the legend keys are not required you we can set the legend.key.height to "0". Finally, note that I fixed the order of the items in the legend by using the group aes to set the order for the stacked bar (instead of reordering the variable mapped on fill).
library(ggplot2)
library(ggtext)
library(patchwork)
p1 <- ggplot(
nonneutral_data,
aes(
x = ifelse(Code %in% c("1", "2", "3"), -Percentage, Percentage),
y = factor(Category, levels = rev(column_names)), # Force the correct order
fill = Code,
group = factor(Code, levels = c("3", "2", "1", "5", "6", "7"))
)
) +
geom_col(position = position_stack(reverse = TRUE)) +
geom_text(aes(label = Label),
position = position_stack(vjust = 0.5, reverse = TRUE),
size = 2.5
) + # Reduced Text Size
scale_fill_manual(
values = cols,
labels = formatted_labels
) +
guides(fill = guide_legend(
title = NULL,
nrow = 1,
byrow = FALSE,
theme = theme(
legend.text.position = "top",
legend.key.width = unit(1, "null"),
legend.key.height = unit(0, "null")
),
override.aes = list(
size = 0
)
)) +
scale_x_continuous(
breaks = x_breaks,
labels = ~ paste0(abs(.x), "%"),
limits = c(-x_left, x_right),
expand = c(0, 0)
) +
geom_vline(
xintercept = 0,
linetype = "solid",
linewidth = 1.5,
color = "grey30"
) +
theme_bw() +
theme(
panel.grid.major.y = element_blank(),
legend.text = element_markdown(size = 8, face = "bold"),
legend.box.just = "left",
legend.justification = "left",
legend.position = "top",
axis.title = element_blank(),
axis.text = element_markdown(),
axis.text.x = element_markdown(hjust = hjust_values),
axis.ticks.y = element_line(),
panel.background = element_blank(),
plot.background = element_rect(fill = "transparent", color = NA),
legend.background = element_blank()
)
p2 <- ggplot(neutral_data, aes(x = Percentage, y = Category, fill = Code)) +
geom_col() +
geom_text(
data = neutral_data %>%
filter(Percentage >= 5),
aes(label = paste0(round(Percentage, 1), "%")),
position = position_stack(vjust = 0.5),
size = 2.5
) +
geom_text(
data = neutral_data %>%
filter(Percentage < 5),
aes(
label = paste0(round(Percentage, 1), "%"),
x = Percentage + 1
),
hjust = 0,
size = 2.5
) + # Reduced text size
scale_fill_manual(
values = cols,
labels = formatted_labels
) +
guides(fill = guide_legend(
title = NULL,
nrow = 1,
theme = theme(
legend.text.position = "top",
legend.key.width = unit(1, "null"),
legend.key.height = unit(0, "null")
),
override.aes = list(size = 0)
)) +
scale_x_continuous(
limits = c(0, x_neutral),
expand = c(0, 0),
labels = ~ paste0(.x, "%")
) +
theme_bw() +
theme(
panel.grid.major.y = element_blank(),
legend.text = element_markdown(size = 8, face = "bold"),
legend.justification = "left",
legend.position = "top",
axis.title = element_blank(),
axis.text = element_markdown(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
panel.background = element_blank(),
plot.background = element_rect(fill = "transparent", color = NA),
legend.background = element_blank()
)
plot_example <- (p1 | p2) +
plot_layout(
guides = "keep",
widths = c(1, 1 / width_ratio)
) +
plot_annotation(
title = "Plot Test",
theme = theme(
plot.title = element_text(
hjust = 0.5,
vjust = 1,
size = 12,
face = "bold"
),
plot.background = element_rect(fill = "transparent", color = NA),
legend.position = "top",
legend.justification = "left",
legend.box.just = "left"
)
)
plot_example
- Conditional recursive formula in dplyr
- Current development in how to adjust individual x axis title using ggplot facet_wrap
- How to reorder a stacked bar chart in ggplot2?
- how can I render a quarto website to a single pdf
- Unable to install tidyverse package for r kernel in jupyter
- How to replace values in a matrix based on a conditional variable
- How can I make my enormous dataframe from wide to long in R?
- Summing polygons by value using terra in R
- R data.table updating a table based on an inner join with another table
- Regression using plm package and twoways effect, when data has NA
- R Shiny - How to have an action button that automatically downloads a csv file (Not download button?)
- Reference the current state of a piped object in R pipe subfunction
- geom_bar color according to 2 vars
- Use purrr::accumulate with condition
- Flip the text in facet rows in gglikert in R
- Count up and down from when condition is met, per category
- pretty_breaks does not working with geom_sf
- Display x-axis with ggh4x::facet_manual when blank panel area under graph
- Rearrage string elements by the number attached with it in rows
- horizontally match two ggplots in R
- Equivalent for R / dplyr's glimpse() function in Python for Panda dataframes?
- Why is reticulate::py_available() FALSE until I I run reticulate::py_run_string("")?
- Pass an optional argument to a custom function for use both directly and in an ellipsis construct
- Calculate relative change in time by group
- How to prevent text overflow in reactable.extras text field?
- Control new line placement of base::stop()
- Format for ordinal dates (day of month with suffixes -st, -nd, -rd, -th)
- How to produce a table.file for input in ReadMe: Software for Automated Content Analysis
- What is the purpose difference between README and vignette in R package?
- Create a multilines Readme.txt with R