Plot Percents with Likert Package - Doesn`t work when grouping

Question

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

Answer 1

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)

Answer 2

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

Answer 3

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),"%") )

Answer 4

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