100% stacked bar chat - r

I'm new to R and trying to get this data in a 100% Stacked Bar chart in R to look like this
The data looks like this
ccEFFECT <- data$Q7_1
ccEFFECT [ccEFFECT == -99] <- NA
ccEFFECTS<- factor(ccEFFECT , labels = c("Strongly Disagree", "Disagree", "Neither Agree nor Disagree", "Agree", "Strongly Agree"))
levels(ccEFFECTS )
str(ccEFFECTS )
summary (ccEFFECTS )
length(na.omit(ccEFFECTS ))
length(ccEFFECTS )
ccEFFECTfrequency <- table (ccEFFECTS ) #frequency
ccEFFECTfrequency
#percentages
ccEFFECT_PERCENTAGE=prop.table(table(ccEFFECTS)) * 100
ccEFFECT_PERCENTAGE
barplot(ccEFFECT_PERCENTAGE)
Q2EFFECT<- data$Q7_2
Q2EFFECT [Q2EFFECT == -99] <- NA
Q2EFFECTS<- factor(Q2EFFECT , labels = c("Strongly Disagree", "Disagree", "Neither Agree nor Disagree", "Agree", "Strongly Agree"))
levels(Q2EFFECTS )# how many levels of a categorical variable
str(Q2EFFECTS )
summary (Q2EFFECTS )
length(na.omit(Q2EFFECTS ))
length(Q2EFFECTS )
Q2EFFECTfrequency <- table (Q2EFFECTS ) #frequency
Q2EFFECTfrequency
#percentages
Q2EFFECT_PERCENTAGE=prop.table(table(Q2EFFECTS)) * 100
Q2EFFECT_PERCENTAGE
barplot(Q2EFFECT_PERCENTAGE)
Any suggestions.

Let dummy is data you give as picture. Then,
dummy <- dummy %>% filter(Q71 != -99)
colnames(dummy) <- c("concern about home price", "concern about jobs", "concern about unemployment","concern about importation", "concern about inflation")
dummy %>%
reshape2::melt(value.name = "response",
measure.var = c("concern about home price",
"concern about jobs",
"concern about unemployment",
"concern about importation",
"concern about inflation")) %>%
group_by(variable, response) %>%
summarise(n = n()/ 29) %>%
ungroup %>%
mutate(response = factor(response, labels = c("Strongly Disagree", "Disagree", "Neither Agree nor Disagree", "Agree", "Strongly Agree"), ordered = T)) %>%
ggplot(aes(fill = response, y = n, x = variable)) +
geom_bar(position = "fill", stat = "identity", width = 0.2) +
coord_flip() + scale_fill_manual(values = c("steelblue", "yellow", "grey", "orange", "darkblue")) +
theme_minimal()
result is like

Related

Error: id variables not found in data: Item when trying to plot in R

I am new to using R, and I am trying to make a diverging stacked bar chart, as demonstrated here and here.
I have the following R code that I modified from working code. My modified code is giving me an error. The error I am getting is Error: id variables not found in data: Item . I do not understand why I'm getting this error.
library("devtools")
library("likert")
scale_height = knitr::opts_chunk$get('fig.height')*0.5
scale_width = knitr::opts_chunk$get('fig.width')*1.25
knitr::opts_chunk$set(fig.height = scale_height, fig.width = scale_width)
theme_update(legend.text = element_text(size = rel(0.7)))
# u = understandability
title_u = "Understandability"
headers_u_n_a = c("Type", "Strongly Disagree", "Disagree", "Neutral", "Agree", "Strongly Agree")
y_label = "Video Transformation"
understandability_csv_text = "Type Strongly Disagree Disagree Neutral Agree Strongly Agree
WT 0.00 0.00 0.00 27.27 72.73
WoT 0.00 18.18 18.18 18.18 45.45
TF 9.09 9.09 36.36 27.27 18.18"
u_data = read.csv(text=understandability_csv_text, header=TRUE, sep="\t")
u_data$Type = as.factor(u_data$Type)
names(u_data) = headers_u_n_a
u_data_summary = likert(summary = u_data)
plot(u_data_summary, plot.percent.neutral=TRUE, plot.percent.low=FALSE, plot.percent.high=FALSE) + ylab(y_label) + ggtitle(title_u)
I was modifying this following MWE:
library("devtools")
library("likert")
scale_height = knitr::opts_chunk$get('fig.height')*0.5
scale_width = knitr::opts_chunk$get('fig.width')*1.25
knitr::opts_chunk$set(fig.height = scale_height, fig.width = scale_width)
theme_update(legend.text = element_text(size = rel(3)))
theme_update(axis.title = element_text(size = rel(4)))
theme_update(plot.title = element_text(size = rel(4)))
theme_update(axis.text = element_text(size = rel(4)))
title_q1 = "I'm satisfied with the way the results are ranked"
headers_q1 = c("Item","Strongly Disagree", "Disagree", "Neither Agree nor Disagree", "Agree", "Strongly Agree")
xlab_first = "Position"
CSV_Text = "K,Strongly Disagree,Disagree,Neither Agree nor Disagree,Agree,Strongly Agree
10,2.752293578,15.59633028,18.34862385,48.62385321,14.67889908
5,1.739130435,5.217391304,6.086956522,48.69565217,38.26086957
1,1.639344262,0,0,13.93442623,84.42622951
20,11.76470588,33.33333333,22.54901961,27.45098039,4.901960784"
first_q1 = read.csv(text=CSV_Text, header=TRUE, sep=",")
first_q1$K= as.factor(first_q1$K)
names(first_q1) = headers_q1
s_first_q1 = likert(summary = first_q1)
plot(s_first_q1, plot.percent.neutral=FALSE, plot.percent.low=FALSE, plot.percent.high=FALSE) + xlab(xlab_first) + ggtitle(title_q1)
I was able to fix it and get it working by changing
headers_u_n_a = c("Type", "Strongly Disagree", "Disagree", "Neutral", "Agree", "Strongly Agree")
to
headers_u_n_a = c("Item", "Strongly Disagree", "Disagree", "Neutral", "Agree", "Strongly Agree")
However, I am still unsure why this was needed.

Error while plotting with ggsave and other save functions

I have a problem concerning the function ggsave() and I would be really grateful for any help and or suggestions/solutions. I am creating four plots and put them all in one big plot, and since I want to loop the whole function using all columns in my dataframe I want to save the created plots in a specified folder (preferably with an identifying name).
plotting_fun3 <- function(Q){
plot1 <- plot_likert(
t(Q),
title = "Total population",
legend.labels = c("strongly disagree","disagree", "neither nor", "agree", "strongly agree"),
grid.range = c(1.6, 1.1),
expand.grid = FALSE,
axis.labels = c(" "),
values = "sum.outside",
show.prc.sign = TRUE,
catcount = 4,
cat.neutral = 3,
)
plot2 <- plot_likert(
t(Q[survey$animal=="Dogs"]),
title = "Female",
legend.labels = c("strongly disagree","disagree", "neither nor", "agree", "strongly agree"),
grid.range = c(1.6, 1.1),
expand.grid = FALSE,
axis.labels = c(" "),
values = "sum.outside",
show.prc.sign = TRUE,
catcount = 4,
cat.neutral = 3,
)
plot3 <- plot_likert(
t(Q[survey$animal=="Cats"]),
title = "Male",
legend.labels = c("strongly disagree","disagree", "neither nor", "agree", "strongly agree"),
grid.range = c(1.6, 1.1),
expand.grid = FALSE,
axis.labels = c(" "),
values = "sum.outside",
show.prc.sign = TRUE,
catcount = 4,
cat.neutral = 3,
)
plot4 <- plot_likert(
t(Q[survey$animal=="Turtle"]),
title = "Others",
legend.labels = c("strongly disagree","disagree", "neither nor", "agree", "strongly agree"),
grid.range = c(1.6, 1.1),
expand.grid = FALSE,
axis.labels = c(" "),
values = "sum.outside",
show.prc.sign = TRUE,
catcount = 4,
cat.neutral = 3,
)
theplot <- ggarrange(plot1, plot2, plot3, plot4,
labels = NULL,
common.legend = TRUE,
legend = "bottom",
ncol = 1, nrow = 4)
#ggsave(filename=paste(Q,".png",sep=""), plot=theplot, device = "png")
#ggsave(filename=paste("animal_plot", ID, ".jpeg"), plot=plots[[x]])
#ggsave(path = "/myDirectory",
# device = "png", filename = "animal_plot", plot = theplot)
#save_plot(filename = "hello", plot = theplot,
# "/myDirectory",
# device = "png")
#ggsave(sprintf("%s.pdf", Q), device = "pdf")
return(theplot)
}
The commented lines show all kinds of ways I have tried to save the plot in my directory. I encounter 2 different problems:
Either: Most of the ggsave suggestions I found on stack overflow. Several of them did not include the line device = "png". If I leave out this line of code I always get something like this:
Fehler: `device` must be NULL, a string or a function.
Run `rlang::last_error()` to see where the error occurred.
If I follow that command I get:
<error/rlang_error>
`device` must be NULL, a string or a function.
Backtrace:
1. global::plotting_fun3(survey[, 9])
2. ggplot2::ggsave(sprintf("%s.pdf", Q))
3. ggplot2:::plot_dev(device, filename, dpi = dpi)
Run `rlang::last_trace()` to see the full context.
> rlang::last_trace()
<error/rlang_error>
`device` must be NULL, a string or a function.
Backtrace:
█
1. └─global::plotting_fun3(survey[, 9])
2. └─ggplot2::ggsave(sprintf("%s.pdf", Q))
3. └─ggplot2:::plot_dev(device, filename, dpi = dpi)
So online I found people with the same or similar problem and the suggestion has always been to use device = "png" or similar.
Now if I do this I encounter a different problem:
The plots are saved in the right directory but the name is wrong. Usually the name is "3.png" or "3.pdf" or depending on what I create. If "3.png" already exists it gives the file another number.
I had this problem in an older project three months ago and couldn't solve it and now I have it again.
For what it's worth, I use macOS Mojave 10.14.6, my R version is Version 1.3.1093
Thank you in advance for any thoughts, suggestions or other comments.
[EDIT]
Here is some sample data:
> str(myDF[,c(2,9:10)])
data.frame': 123 obs. of 3 variables:
$ animal: chr "Cats" "Cats" "Turtles" "Cats" ...
$ q8 : int 3 5 5 3 4 4 2 5 3 5 ...
$ q9.1 : int 4 5 5 4 3 4 2 4 2 4 ...
The values stay between 1 and 5 for all observations. They actually represent answers such as "strongly agree", "agree", "neither agree nor disagree"...etc.
Alternatively, if you prefer this to the other one:
> myDF[,c(2,9:10)]
animal q8 q9.1
1 Cats 3 4
2 Cats 5 5
3 Turtles 5 5
4 Cats 3 4
5 Turtles 4 3
6 Turtles 4 4
7 Turtles 2 2
8 Cats 5 4
9 Cats 3 2
10 Turtles 5 4
11 Turtles 4 3
12 Turtles 3 3
13 Dogs 3 3
14 Cats 3 3
15 Dogs 1 1
16 Dogs 1 3
The issue with file name is due to you use Q which is a dataframe in the filename defintion so it will result in some very messy way depend on how your system handling filename.
# This command result in a few long character depend on number of columns in Q.
# 4 columns w+ill result 4 long character and ggsvave will return the error
# Error: `device` must be NULL, a string or a function.
ggsave(filename=paste(Q,".png",sep=""), plot=theplot, device = "png")
# Again not sure what ID is here but if it was a dataframe you got
# same error with previous one.
ggsave(filename=paste("animal_plot", ID, ".jpeg"), plot=plots[[x]])
# This one it doesn't specific a file name but a directory
# ggsave will return an error:
# Error: Unknown graphics device ''
# If you specify device = "png" - error will be:
# Error in grid.newpage() : could not open file '/home/sinh'
ggsave(path = "/myDirectory",
device = "png", filename = "animal_plot", plot = theplot)
# Why there is a param "/myDirectory" here? and you should specify the extention
# in the file name. So the correct param is:
# filename = "/myDirectory/hello.png"
save_plot(filename = "hello", plot = theplot,
"/myDirectory",
device = "png")
Here is one that should work properly but you need to input file name manually:
character_variable <- "my_character_variable_here_"
index_number <- 20
# If you specify sep = "" then just need to use paste0
file_name <- paste0(character_variable, index_number)
ggsave(filename=paste(file_name, ".jpeg"), plot=plots[[x]], device = "png")
And here is my rewrite function based on your function. You may try it out and tweak it a bit
# df is your survey data.frame
# q_column_name is the name of questionare column that you want to graph.
# the final output file will use q_column_name as file name.
plotting_fun3 <- function(df, q_column_name){
require(foreach)
require(dplyr)
require(tidyr)
graph_data <- df %>% select(one_of("animal", q_column_name))
plot1 <- plot_likert(
t(graph_data),
title = "Total population",
legend.labels = c("strongly disagree","disagree", "neither nor", "agree", "strongly agree"),
grid.range = c(1.6, 1.1),
expand.grid = FALSE,
axis.labels = c(" "),
values = "sum.outside",
show.prc.sign = TRUE,
catcount = 4,
cat.neutral = 3,
)
animal_plots <- foreach(current_animal = c("Dog", "Cats", "Turtle")) %do% {
plot_likert(
t(graph_data %>% filter(animal == current_animal)),
title = "Female",
legend.labels = c("strongly disagree","disagree", "neither nor", "agree", "strongly agree"),
grid.range = c(1.6, 1.1),
expand.grid = FALSE,
axis.labels = c(" "),
values = "sum.outside",
show.prc.sign = TRUE,
catcount = 4,
cat.neutral = 3
)
}
theplot <- ggarrange(plot1, animal_plots[[1]],
animal_plots[[2]], animal_plots[[3]],
labels = NULL,
common.legend = TRUE,
legend = "bottom",
ncol = 1, nrow = 4)
ggsave(filename=paste(q_column_name, ".png",sep=""), plot=theplot, device = "png")
return(theplot)
}
Here is how to use the function
# Assume that your survey dataframe variable is myDF
my_new_plot <- plotting_fun3(df = myDF, q_column_name = "q8")
[Updated] - Added the function to solve the graph issue.
For anyone encountering a similar problem in a less complicated setting: double check if you are passing a valid path/filename string to ggsave()!
In my case, I made a mistake with string processing using str_split() and path concatenation. Therefore, ggsave() was not given a valid single-string path, promting the Error: 'device' must be NULL, a string or a function. The error had nothing to do with my 'device' but I was simply not passing a proper string. Once I fixed the path, the issue was solved.

How to change the legend title of my ggplots based on outcomes?

I wonder if there is an efficent way to change the legend title of my ggplots based on outcomes.
Example
I have a function which helps me to filter a data base by type and by county.
df without filter
county | date | value | type
-----------------------------------
Alameda 2020-01-01 6 positive
Alameda 2020-01-02 2 negative
Alameda 2020-01-03 1 positive
LA 2020-01-04 4 positive
LA 2020-01-03 1 positive
** Function **
function_forggplot <- function(data = df,
select_county = "Alameda",
type_order = unique(df$type)) {
#Filter data base
df_outcome <- df[df$county %in% select_county,]
df_outcome <- df_outcome[df_outcome$type %in% type_order,]
gg_outcome <- ggplot(
data = df_outcome,
aes(x = date,
y = value,
color = type
)) +
geom_line(size = .5)
I want change the legend title of my ggplot2 based on the outcome for example if the user select county= LA and type = positive. I want a title in my ggplot like "Results positives for LA".
With if else conditionals works but I have more than 100 cases so I think this not a good option.
Expect outcome
function_forggplot(county="Alameda", type = "negatives")
A ggplot object with this title "Results negatives for Alameda"
function_forggplot(county="Fresno", type = "postives")
A ggplot object with this title "Results pisitives for Fresno"
Thanks
You can adapt the code you showed in the function directly like this. Also you can use paste0() for the title (no need of other packages):
library(ggplot2)
#Function
funplot <- function(df, select_county, type_order) {
#Filter data base
df_outcome <- df[df$county == select_county,]
df_outcome <- df_outcome[df_outcome$type == type_order,]
#Plot
ggplot(df_outcome,aes(x = date, y = value)) +
geom_line() +
ggtitle(paste0("Results ",select_county," for ",type_order))
}
#Apply
funplot(mydf, 'Alameda', 'positive')
Output:
Some data used:
#Data
mydf <- structure(list(county = c("Alameda", "Alameda", "Alameda", "LA",
"LA"), date = structure(c(18262, 18263, 18264, 18265, 18264), class = "Date"),
value = c(6L, 2L, 1L, 4L, 1L), type = c("positive", "negative",
"positive", "positive", "positive")), row.names = c(NA, -5L
), class = "data.frame")
We can create the function with glue as it is very flexible to get objects specified within {}. Of course, we can use paste or sprintf as well. Anyway, ggplot is an external package. So using, another package from the tidyverse, would make this more tidier.
library(ggplot2)
library(dplyr)
f1 <- function(dat, county_nm, type_nm) {
dat %>%
filter(county == county_nm, type == type_nm) %>%
ggplot(aes(x = date, y = value)) +
geom_line() +
ggtitle(glue::glue("Results {type_nm} for {county_nm}"))
}
then, we call as
f1(df, 'LA', 'positive')
-output
Or without any packages (other than ggplot2, dplyr)
f2 <- function(dat, county_nm, type_nm) {
dat %>%
filter(county == county_nm, type == type_nm) %>%
ggplot(aes(x = date, y = value)) +
geom_line() +
ggtitle(sprintf("Results %s for %s", type_nm, county_nm))
}
data
df <- structure(list(county = c("Alameda", "Alameda", "Alameda", "LA",
"LA"), date = structure(c(18262, 18263, 18264, 18265, 18264), class = "Date"),
value = c(6L, 2L, 1L, 4L, 1L), type = c("positive", "negative",
"positive", "positive", "positive")), row.names = c(NA, -5L
), class = "data.frame")

How to store loop table data

I am a newbie in R. Could somebody please help me with this problem? I want to store the loop table data and export it into excel file, but I have not succeeded. Thanks.
Qquest7 <- c("A", "B", "A", "A", "A", "B", "B", "B", "B", "A")
Qquest24 <- c("neutral", "somewhat satisfied", "somewhat satisfied", "not able to rate", "somewhat satisfied", "less satisfied", "not able to rate", "dissatisfied", "very satisfied", "dissatisfied")
Qquest25 <- c("not able to rate", "not able to rate", "not able to rate", "somewhat satisfied", "not able to rate", "not able to rate", "dissatisfied", "dissatisfied", "not able to rate", "very satisfied")
Qquest26 <- c("not able to rate", "somewhat satisfied", "not able to rate", "less satisfied", "not able to rate", "neutral", "somewhat satisfied", "neutral", "neutral", "somewhat satisfied")
Qquest27 <- c("very satisfied", "not able to rate", "somewhat satisfied", "neutral", "very satisfied", "neutral", "neutral", "somewhat satisfied", "neutral", "not able to rate")
Qquest28 <- c("not able to rate", "not able to rate", "not able to rate", "not able to rate", "not able to rate", "not able to rate", "very satisfied", "neutral", "somewhat satisfied", "neutral")
Qquest29 <- c("desktop", "laptop", "tablet", "cellphone", "desktop", "desktop", "tablet", "laptop", "cellphone", "laptop")
df <- data.frame(Qquest7, Qquest24, Qquest25, Qquest26, Qquest27, Qquest28, Qquest29)
library(openxlsx)
trial2429 <- c("Qquest24","Qquest25", "Qquest26", "Qquest27", "Qquest28", "Qquest29")
x <- data.frame()
y <- data.frame()
for (i in df[trial2429]){
x[i] <- table(df$Qquest7, i)
y <- print(x)
}
write.xlsx(y, file = "trial2429.xlsx")
I'm not 100% what you're after as desired output, but this function I've used for my own purposes might do the trick for you. Using your df and trial2429 for data, first give trial2429 some names:
names(trial2429) <- trial2429
Now, build a function that takes a list and sequentially adds its contents to a .csv file:
## Export list
export_results <- function(df_list, file_name = "outfile.csv") {
if (file.exists(file_name)) {
file.remove(file_name)
print("Removed old file.")
}
## Clean export function
writeout <- function(table_name) {
write(table_name, file_name, sep = ",", append = TRUE)
tab.out <- df_list[[table_name]]
tab.out <- cbind(rownames(tab.out), tab.out)
write.table(
tab.out,
file_name,
row.names = FALSE,
sep = ",",
append = TRUE
)
write("", file_name, sep = ",", append = TRUE)
}
for (i in names(df_list)) {
writeout(i)
}
}
Get the table version for each question that you're after, and store it in a list:
q.list <- lapply(trial2429, function(x){
table(df$Qquest7, df[[x]])
})
Call the function defined above on that list:
export_results(q.list, file_name = "trial2429.csv")
It'll throw some warning messages, but it seems to not cause any problems- your output should like this in Excel:
Edit: Fixed number-of-columns issue

Likert Package - Plot Percents [duplicate]

I've created some charts using the Likert package, however when I create plots by groups the plot.percents = TRUE won't give me the labels for each response category. The plot.percents.high =TRUE and plot.percents.low = TRUE gives me the combined percentage, however I want it for all of the response categories. It works fine with the ungrouped data. The code I`m using is:
Make some data
library(likert)
library (reshape)
Group <- c("Group 1", "Group 1", "Group 1", "Group 1", "Group 1", "Group 1", "Group 1", "Group 2", "Group 2", "Group 2", "Group 2", "Group 2",
"Group 2","Group 2", "Group 3", "Group 3", "Group 3", "Group 3","Group 3","Group 3","Group 3")
Var1 <- c("Agree", "Agree", "Strongly agree", "Agree", "Strongly disagree", "Agree","Strongly agree", "Disagree", "Strongly agree",
"Strongly agree", "Agree", "Disagree", "Agree", "Strongly disagree", "Agree", "Agree", "Agree", "Disagree", "Strongly agree",
"Strongly disagree", "Strongly agree")
df <- as.data.frame (cbind(Group, Var1))
Variable <- c("Var1")
df2 <- (df[Variable])
likert.df <- likert (df2)
likert.df.group <- likert (df2, grouping=df$Group)
likert.df is the responses for all, likert.df.group is the responses for each group. When I run the plot (below) with just likert.df, I get the percentages for each response, when I run it for likert.df.group, they disappear.
likert.bar.plot(likert.df, low.color = "#007CC2",
high.color = "#F7971C", neutral.color = "grey90",
neutral.color.ramp = "white", plot.percent.low = FALSE,
plot.percent.high = FALSE, plot.percent.neutral = FALSE,
plot.percents = TRUE, text.size = 4,
text.color = "black", centered = FALSE,
include.center = FALSE, ordered = FALSE,
wrap.grouping = 50, legend = "Response",
legend.position = "bottom", panel.arrange = "v",
panel.strip.color = "grey90")+
ggtitle("Chart Title") +
theme (panel.background = element_rect(fill="NA")) +
theme (axis.text.y = element_text (colour="black", size="10", hjust=0))+
theme (axis.text.x = element_text (colour="black", size="10")) +
theme (legend.title = element_blank())+
theme (plot.margin = unit (c(0,0,0,0),"mm"))
Am I missing something?
According to the function source, printing of plot.percents is not currently supported for grouped analysis. See https://github.com/jbryer/likert/blob/master/R/plot.likert.bar.r#L174
There's a slight problem with the package code, which is easy to fix (unless I am overlooking something else).
On line 175 https://github.com/jbryer/likert/blob/master/R/plot.likert.bar.r#L175 change:
# lpercentpos <- ddply(results[results$value > 0,], .(Item), transform,
lpercentpos <- ddply(results[results$value > 0,], .(Group, Item), transform,
on line 177 https://github.com/jbryer/likert/blob/master/R/plot.likert.bar.r#L177 change:
# p + geom_text(data=lpercentpos, aes(x=Group, y=pos, label=paste0(round(value), '%'),
p <- p + geom_text(data=lpercentpos, aes(x=Group, y=pos, label=paste0(round(value), '%'),
and on line 184 https://github.com/jbryer/likert/blob/master/R/plot.likert.bar.r#L184 change:
# lpercentneg <- ddply(lpercentneg, .(Item), transform,
lpercentneg <- ddply(lpercentneg, .(Group, Item), transform,
Then uncomment this section and remove FALSE from the if statement
# if(FALSE & plot.percents) { #TODO: implement for grouping
if(plot.percents) {
Here's the snippet which goes inside the if statement:
# if(FALSE & plot.percents) { #TODO: implement for grouping
if(plot.percents) {
# warning('plot.percents is not currenlty supported for grouped analysis.')
lpercentpos <- ddply(results[results$value > 0,], .(Group, Item), transform,
pos = cumsum(value) - 0.5*value)
p <- p + geom_text(data=lpercentpos, aes(x=Group, y=pos, label=paste0(round(value), '%'),
group=Item), size=text.size)
lpercentneg <- results[results$value < 0,]
if(nrow(lpercentneg) > 0) {
lpercentneg <- lpercentneg[nrow(lpercentneg):1,]
lpercentneg$value <- abs(lpercentneg$value)
lpercentneg <- ddply(lpercentneg, .(Group, Item), transform,
pos = cumsum(value) - 0.5*value)
lpercentneg$pos <- lpercentneg$pos * -1
p <- p + geom_text(data=lpercentneg, aes(x=Item, y=pos, label=paste0(round(abs(value)), '%')),
size=text.size)
}
}
I haven't done much testing, but your test data works fine and produces this output:
I fixed this issue and submitted a pull request to Jason. In the meantime you can pull the changes from here: https://github.com/aseidlitz/likert
I wrote a little add-on based off the source code, if you don't want to bother modding the source material. Just takes the answer above and applies it. Shouldn't be too hard to put into a user function if you make a lot of graphs with it. I have been doing some work trying to get the percents added and then figure a way to add the N's somewhere on the graph.
library(likert)
library(reshape)
library(plyr)
#--------------- Works using likert package, problems with the modded source code)
rm(list=ls(all=T))
# ---------------- Example Data -------------------- #
likert.responses <- c("Agree", "Neutral", "Strongly agree", "Disagree", "Strongly disagree", NA)
questions <- c("Q_1","Q_2","Q_3")
groupA <- c("White", "Afr. American", "Hispanic", "Other")
set.seed(12345)
mydata <- data.frame(
race = sample(groupA, 100, replace=T, prob=c(.3,.3,.3,.01)),
Q_1 = sample(likert.responses, 100, replace=T, prob=c(.2,.2,.2,.2,.19,.01)),
Q_2 = sample(likert.responses, 100, replace=T, prob=c(.1,.2,.2,.29,.2, .01)),
Q_3 = sample(likert.responses, 100, replace=T, prob=c(.4,.2,.09,.15,.15,.01))
)
mydata.que <- mydata[questions]
mydata.que[] <- lapply(mydata.que, factor,
levels=c("Strongly disagree", "Disagree", "Neutral", "Agree","Strongly agree"))
mydata.1 <- likert(mydata.que)
mydata.group <- likert(mydata.que, grouping=mydata$race)
p <- plot(mydata.group, centered=F, # This controls stacked versus the "centered" option
ordered=F,
plot.percents = TRUE
) + ggtitle("Likert Test")
# --- Gets the percentages from the likert object -- #
results <- mydata.group$results
results <- reshape::melt(results, id=c('Group', 'Item'))
results$variable <- factor(results$variable, ordered=TRUE)
lpercentpos <- ddply(results[results$value > 0,], .(Group, Item), transform,
pos = cumsum(value) - 0.5*value)
lpercentpos <- subset(lpercentpos, variable != "Neutral" & value != 100 & value != 0)
# -- Double checking percents are right -- #
prop.table(table(mydata$race, mydata$Q_1),1)
pworks <- p + geom_text(data=lpercentpos, aes(x=Group, y=pos, label=paste0(round(value), '%'),
group=Item),
size=3)
pworks
# --- Using the OP's code --- #
p <- plot(likert.df.group, centered=F, # This controls stacked versus the "centered" option
ordered=F,
plot.percents = TRUE
) + ggtitle("Likert Test")
results <- likert.df.group$results
results <- reshape::melt(results, id=c('Group', 'Item'))
results$variable <- factor(results$variable, ordered=TRUE)
lpercentpos <- ddply(results[results$value > 0,], .(Group, Item), transform,
pos = cumsum(value) - 0.5*value)
lpercentpos <- subset(lpercentpos, variable != "Neutral" & value != 100 & value != 0)
prop.table(table(likert.df.group$race, likert.df.group$Q_1),1)
pworks <- p + geom_text(data=lpercentpos, aes(x=Group, y=pos, label=paste0(round(value), '%'),
group=Item),
size=3)
pworks
Even the example script that's included in the likert package documentation using the pisaitems data will not graph correctly the percent labels. It ends up looking like the image below when you run this code.
require(likert)
data(pisaitems)
##### Item 29: How often do you read these materials because you want to?
title <- "How often do you read these materials because you want to?"
items29 <- pisaitems[,substr(names(pisaitems), 1,5) == 'ST25Q']
head(items29); ncol(items29)
names(items29) = c("Magazines", "Comic books", "Fiction", "Non-fiction books", "Newspapers")
l29g <- likert(items29, grouping=pisaitems$CNT)
# Plots
plot(l29g, plot.percents=TRUE, plot.percent.low=FALSE,
plot.percent.high=FALSE, plot.percent.neutral=FALSE) +
ggtitle(title)
Hey I tried it out and it doesn't work for me either using the grouping data. There is no mention of why despite plot.percent.low and plot.percent.high working fine. Unless someone else cracks it all I can do is offer a workaround using plot() instead of likert.bar.plot and text()
Here I label the Agree category only for all three groups.
plot(likert.df.group, type="bar")
text(c(0.35,0.35,0.35), c(0.85,0.6,0.25),
labels = paste0(c(42.8,28.57,42.85),"%") )

Resources