Data
# Libraries
library(dplyr)
library(expss) # for apply_labels
# Create data
sample_prob <- function(n){
x <- sample(1:100,n)
return(x/sum(x))
}
set.seed(1806)
n <- 11
dataset <- data.frame(
question1 = factor(sample(0:(n-1), size=500, replace=T, prob = sample_prob(n))),
question2 = factor(sample(0:(n-1), size=500, replace=T, prob = sample_prob(n))),
question3 = factor(sample(0:(n-1), size=500, replace=T, prob = sample_prob(n))),
group = factor(sample(c("group1", "group2"), size=500, replace=T))) %>%
apply_labels(
question1 = "Voici un très long ou très long énoncé pour la question 1",
question2 = "Voici un très long ou très long énoncé pour la question 2",
question3 = "Voici un très long ou très long énoncé pour la question 3")Likert plot by groups
# Libraries
library(likert)
library(stringr)
# Function to get order of items in the likert plot
get_order <- function(likert_obj){
n_rep <- ncol(likert_obj$results)-1
tmp <- likert_obj$results[, c(1, (round(n_rep/2)+2):(n_rep+1))]
tmp$order <- apply(tmp[, -1], 1, sum)
order <- tmp$Item[order(tmp$order)]
return(order)
}
# Create likert objects
p_group1 <- likert(dataset[dataset$group=="group1", -which(names(dataset)=="group")])
p_group2 <- likert(dataset[dataset$group=="group2", -which(names(dataset)=="group")])
# Get order
order <- get_order(p_group1)
# Build plots
plot_group1 <- plot(p_group1, text.size=4) +
ggtitle("Group 1") +
scale_x_discrete(limits = rev(order), labels = function(x) str_wrap(x, 20)) + # if no labels, to set the width of y-axis text
egg::theme_article() +
theme(
# group labels
strip.background = element_blank(),
strip.text.x = element_text(size = 9, margin = margin(0,0,0.12,0, "cm")), # margin(top, right, bottom, left, "cm")
# axes
axis.title.x = element_text(size = 8), # x axis title
axis.text.x = element_text(size = 9), # x axis labels
axis.title.y = element_text(size = 8), # y axis title
axis.text.y = element_text(size = 11), # y axis labels
# legend
# legend.title = element_text(size = 10),
legend.title = element_blank(),
legend.text = element_text(size = 7.5),
legend.position = "bottom"
) +
guides(fill=guide_legend(ncol=11))
plot_group2 <- plot(p_group2, text.size=4) +
ggtitle("Group 2") +
scale_x_discrete(limits = rev(order), labels = function(x) str_wrap(x, 20)) + # if no labels, to set the width of y-axis text
egg::theme_article() +
theme(
# group labels
strip.background = element_blank(),
strip.text.x = element_text(size = 9, margin = margin(0,0,0.12,0, "cm")), # margin(top, right, bottom, left, "cm")
# axes
axis.title.x = element_text(size = 8), # x axis title
axis.text.x = element_text(size = 9), # x axis labels
axis.title.y = element_text(size = 8), # y axis title
# axis.text.y = element_text(size = 11), # y axis labels
axis.text.y = element_blank(), # y axis labels
# legend
# legend.title = element_text(size = 10),
legend.title = element_blank(),
legend.text = element_text(size = 7.5),
legend.position = "bottom"
) +
guides(fill=guide_legend(ncol=11))
ggpubr::ggarrange(
ggpubr::ggarrange(plot_group1 + theme(legend.position="none"),
plot_group2 + theme(legend.position="none"),
widths = c(0.55, 0.45)),
ggpubr::get_legend(plot_group1), nrow=2, heights = c(0.9, 0.1))
If you want to add labels:
# Libraries
library(likert)
library(stringr)
# Function to get labels et set the width
get_label_df <- function(dataset, wrap=NULL){
vect_label <- NULL
for(i in names(dataset)){
label <- attr(dataset[, i], "label")
if(is.null(label)) label <- i
vect_label <- c(vect_label, label)
}
if(!is.null(wrap)){
vect_label <- vect_label %>% str_wrap(20)
}
names(vect_label) <- names(dataset)
return(vect_label)
}
# Function to get order of items in the likert plot
get_order <- function(likert_obj){
n_rep <- ncol(likert_obj$results)-1
tmp <- likert_obj$results[, c(1, (round(n_rep/2)+2):(n_rep+1))]
tmp$order <- apply(tmp[, -1], 1, sum)
order <- tmp$Item[order(tmp$order)]
return(order)
}
# Create likert objects
p_group1 <- likert(dataset[dataset$group=="group1", -which(names(dataset)=="group")])
p_group2 <- likert(dataset[dataset$group=="group2", -which(names(dataset)=="group")])
# Get order
order <- get_order(p_group1)
# Label vector with wrap option to set the width of the y-axis text
vect_labels <- get_label_df(p_group1$items, 20)
# Build plots
plot_group1 <- plot(p_group1, group.order = c("question1", "question2", "question3")) +
ggtitle("Group 1") +
# scale_x_discrete(limits = rev(order), labels = function(x) str_wrap(x, 20)) + # if no labels, to set the width of y-axis text
scale_x_discrete(limits = rev(order), labels = vect_labels) + # if no labels, to set the width of y-axis text
egg::theme_article() +
theme(
# axes
axis.title.x = element_text(size = 8), # x axis title
axis.text.x = element_text(size = 9), # x axis labels
axis.title.y = element_text(size = 8), # y axis title
axis.text.y = element_text(size = 11), # y axis labels
# legend
# legend.title = element_text(size = 10),
legend.title = element_blank(),
legend.text = element_text(size = 7.5),
legend.position = "bottom"
) +
guides(fill=guide_legend(ncol=11))
plot_group2 <- plot(p_group2) +
ggtitle("Group 2") +
# scale_x_discrete(limits = rev(order), labels = function(x) str_wrap(x, 20)) + # if no labels, to set the width of y-axis text
scale_x_discrete(limits = rev(order), labels = vect_labels) + # if no labels, to set the width of y-axis text
egg::theme_article() +
theme(
# axes
axis.title.x = element_text(size = 8), # x axis title
axis.text.x = element_text(size = 9), # x axis labels
axis.title.y = element_text(size = 8), # y axis title
# axis.text.y = element_text(size = 8), # y axis labels
axis.text.y = element_blank(), # y axis labels
# legend
# legend.title = element_text(size = 10),
legend.title = element_blank(),
legend.text = element_text(size = 7.5),
legend.position = "bottom"
) +
guides(fill=guide_legend(ncol=11))
ggpubr::ggarrange(
ggpubr::ggarrange(plot_group1 + theme(legend.position="none"),
plot_group2 + theme(legend.position="none"),
widths = c(0.55, 0.45)),
ggpubr::get_legend(plot_group1), nrow=2, heights = c(0.9, 0.1))