Based on the given code you can achieve your desired result using `y_sort = factor(var, levels = rev(desired_order))`:
``` r
library(tidyverse)
library(ggstats)
library(patchwork)
# Define the order of 'var' levels
desired_order <- c("A", "C", "D", "E", "B")
# Ensure 'var' is a factor with the specified order
dat <- df |>
mutate(
var = factor(var, levels = desired_order),
across(-var, ~ factor(.x, likert_levels))
) |>
pivot_longer(-var, names_to = "group") |>
count(var, value, group) |>
complete(var, value, group, fill = list(n = 0)) |>
mutate(
prop = n / sum(n),
prop_lower = sum(prop[value %in% likert_levels[1:2]]),
prop_higher = sum(prop[value %in% likert_levels[4:5]]),
.by = c(var, group)
) |>
arrange(group, prop_lower) |>
mutate(
y_sort = factor(var, levels = rev(desired_order))
)
top10 <- dat |>
distinct(group, var, prop_lower) |>
slice_max(prop_lower, n = 10, by = group)
dat <- dat |>
semi_join(top10)
#> Joining with `by = join_by(var, group, prop_lower)`
dat_tot <- dat |>
distinct(group, var, y_sort, prop_lower, prop_higher) |>
pivot_longer(-c(group, var, y_sort),
names_to = c(".value", "name"),
names_sep = "_"
) |>
mutate(
hjust_tot = ifelse(name == "lower", 1, 0),
x_tot = ifelse(name == "lower", -1, 1)
)
dat_bar <- dat |>
summarise(
n = sum(n), .by = c(y_sort, group)
)
p1 <- ggplot(dat, aes(y = y_sort, x = prop, fill = value)) +
geom_col(position = position_likert(reverse = FALSE)) +
geom_text(
aes(
label = label_percent_abs(hide_below = .05, accuracy = 1)(prop),
color = after_scale(hex_bw(.data$fill))
),
position = position_likert(vjust = 0.5, reverse = FALSE),
size = 3.5
) +
geom_label(
aes(
x = x_tot,
label = label_percent_abs(accuracy = 1)(prop),
hjust = hjust_tot,
fill = NULL
),
data = dat_tot,
size = 3.5,
color = "black",
fontface = "bold",
label.size = 0,
show.legend = FALSE
) +
scale_y_discrete(labels = \(x) gsub("\\..*$", "", x)) +
scale_x_continuous(
labels = label_percent_abs(),
expand = c(0, .15)
) +
scale_fill_brewer(palette = "BrBG") +
facet_wrap(~group,
scales = "free_y", ncol = 1,
strip.position = "right"
) +
theme_light() +
theme(
legend.position = "bottom",
panel.grid.major.y = element_blank(),
strip.text = element_blank()
) +
labs(x = NULL, y = NULL, fill = NULL)
p2 <- ggplot(dat_bar, aes(y = y_sort, x = n)) +
geom_col() +
geom_label(
aes(
label = label_number_abs(hide_below = .05, accuracy = 1)(n)
),
size = 3.5,
hjust = 1,
fill = NA,
label.size = 0,
color = "white"
) +
scale_y_discrete(labels = \(x) gsub("\\..*$", "", x)) +
scale_x_continuous(
labels = label_number_abs(),
expand = c(0, 0, 0, .05)
) +
facet_wrap(~group,
scales = "free_y", ncol = 1,
strip.position = "right"
) +
theme_light() +
theme(
legend.position = "bottom",
panel.grid.major.y = element_blank()
) +
labs(x = NULL, y = NULL, fill = NULL)
# Combine the plots
p1 + p2 +
plot_layout(
guides = "collect"
) &
theme(legend.position = "bottom")
```
<!-- -->
There's a lot going on in this question and I may have misunderstood; is this your intended outcome?
``` r
library(tidyverse)
library(ggpubr)
library(ggstats)
library(patchwork)
var_levels <- c("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q")
likert_levels <- c(
"Strongly disagree",
"Disagree",
"Neither agree nor disagree",
"Agree",
"Strongly agree"
)
# Set seed for reproducibility
set.seed(42)
# Create the dataframe with three Likert response columns
df <- tibble(
var = sample(var_levels, 50, replace = TRUE), # Random values from A to Q
val1 = sample(likert_levels, 50, replace = TRUE) # Random values from Likert levels
)
# View the first few rows of the dataframe
print(df)
#> # A tibble: 50 × 2
#> var val1
#> <chr> <chr>
#> 1 Q Strongly agree
#> 2 E Agree
#> 3 A Agree
#> 4 J Strongly disagree
#> 5 D Neither agree nor disagree
#> 6 Q Neither agree nor disagree
#> 7 O Strongly agree
#> 8 G Strongly agree
#> 9 D Agree
#> 10 E Strongly agree
#> # ℹ 40 more rows
dat <- df |>
mutate(
across(-var, ~ factor(.x, likert_levels))
) |>
pivot_longer(-var, names_to = "group") |>
count(var, value, group) |>
complete(var, value, group, fill = list(n = 0)) |>
mutate(
prop = n / sum(n),
prop_lower = sum(prop[value %in% c("Strongly disagree", "Disagree")]),
prop_higher = sum(prop[value %in% c("Strongly agree", "Agree")]),
.by = c(var, group)
) |>
arrange(group, prop_lower) |>
mutate(
y_sort = paste(var, group, sep = "."),
y_sort = fct_inorder(y_sort)
)
top10 <- dat |>
distinct(group, var, prop_lower) |>
slice_max(prop_lower, n = 10, by = group)
dat <- dat |>
semi_join(top10)
#> Joining with `by = join_by(var, group, prop_lower)`
dat_tot <- dat |>
distinct(group, var, y_sort, prop_lower, prop_higher) |>
pivot_longer(-c(group, var, y_sort),
names_to = c(".value", "name"),
names_sep = "_"
) |>
mutate(
hjust_tot = ifelse(name == "lower", 1, 0),
x_tot = ifelse(name == "lower", -1, 1)
)
bar_plot <- dat %>%
select(var, n) %>%
group_by(var) %>%
summarise(count = sum(n)) %>%
full_join(dat) %>%
select(y_sort, count) %>%
unique() %>%
ggplot(., aes(y = y_sort, x = count)) +
geom_bar(stat = "identity", fill = "lightgrey") +
labs(x="Response Count",y="") +
geom_text(aes(label = count),
position = position_stack(vjust = .5)) +
theme_bw() +
theme(
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.text.x = element_blank(), # Remove x-axis text
axis.ticks.x = element_blank() # Remove x-axis ticks
)
#> Joining with `by = join_by(var)`
likert_plot <- dat %>%
ggplot(aes(y = y_sort, x = prop,
fill = value)) +
geom_col(position = position_likert(reverse = FALSE)) +
geom_text(
aes(
label = label_percent_abs(hide_below = .05, accuracy = 1)(prop),
color = after_scale(hex_bw(.data$fill))
),
position = position_likert(vjust = 0.5, reverse = FALSE),
size = 3.5
) +
geom_label(
aes(
x = x_tot,
label = label_percent_abs(accuracy = 1)(prop),
hjust = hjust_tot,
fill = NULL
),
data = dat_tot,
size = 3.5,
color = "black",
fontface = "bold",
label.size = 0,
show.legend = FALSE
) +
scale_y_discrete(labels = \(x) gsub("\\..*$", "", x)) +
scale_x_continuous(
labels = label_percent_abs(),
expand = c(0, .15)
) +
scale_fill_brewer(palette = "BrBG") +
facet_wrap(~group,
scales = "free_y", ncol = 1,
strip.position = "right"
) +
theme_light() +
theme(
legend.position = "bottom",
panel.grid.major.y = element_blank()
) +
labs(x = NULL, y = NULL, fill = NULL)
bar_plot + likert_plot + plot_layout(guides = "collect") &
theme(legend.position="bottom")
```
[![image_1.png][1]][1]
---
Or with different widths:
``` r
bar_plot + likert_plot + plot_layout(guides = "collect", widths = c(0.2, 0.8)) &
theme(legend.position="bottom")
```
[![image_2.png][2]][2]
<sup>Created on 2024-12-09 with [reprex v2.1.0](https://reprex.tidyverse.org)</sup>
[1]: https://i.sstatic.net/w8J6wzY8.png
[2]: https://i.sstatic.net/2f7O4CXM.png
