i have a data frame in R called df :
# Define categories and Likert levels
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
)
library(tidyverse)
library(ggstats)
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)
)
i want to calculate the liekrt chart :
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()
) +
labs(x = NULL, y = NULL, fill = NULL)
resulting to the image. But i want to see only the totals at right and at left and the middle category. Not to show the "Disaggree" or "Agree" percentages. For example in the picture in the last line i want ot show 33% at left 33% at right and 33% at the white color bar for "Neither agree nor disagree" likert category.
How can i do it in R ?
To achieve your desired result you can use an ifelse
to assign the non-desired categories an empty ""
as the label:
library(ggplot2)
library(ggstats)
ggplot(dat, aes(y = y_sort, x = prop, fill = value)) +
geom_col(position = position_likert(reverse = FALSE)) +
geom_text(
aes(
label = ifelse(
value %in% "Neither agree nor disagree",
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)