使用 Likert 包绘制百分比 - 分组时不起作用答案

【问题标题】：Plot Percents with Likert Package - Doesn`t work when grouping使用 Likert 包绘制百分比 - 分组时不起作用
【发布时间】：2013-11-18 20:55:14
【问题描述】：

我使用 Likert 包创建了一些图表，但是当我按组创建图时，plot.percents = TRUE 不会给我每个响应类别的标签。 plot.percents.high =TRUE 和 plot.percents.low = TRUE 给了我综合百分比，但是我希望它用于所有响应类别。它适用于未分组的数据。我正在使用的代码是：

制作一些数据

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 是所有的响应，likert.df.group 是每个组的响应。当我只用likert.df 运行图（下图）时，我得到每个响应的百分比，当我为likert.df.group 运行它时，它们消失了。

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

我错过了什么吗？

【问题讨论】：

can you provide data 所以我们可以重现这种行为？
我添加了一些数据来重现图表。

标签： r

【解决方案1】：

根据函数来源，目前不支持打印plot.percents进行分组分析。见https://github.com/jbryer/likert/blob/master/R/plot.likert.bar.r#L174

包代码有一个小问题，很容易修复（除非我忽略了其他东西）。

上线175https://github.com/jbryer/likert/blob/master/R/plot.likert.bar.r#L175改：

# lpercentpos <- ddply(results[results$value > 0,], .(Item), transform, 
  lpercentpos <- ddply(results[results$value > 0,], .(Group, Item), transform,

在线 177 https://github.com/jbryer/likert/blob/master/R/plot.likert.bar.r#L177 更改：

#    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), '%'),

并在第 184 行 https://github.com/jbryer/likert/blob/master/R/plot.likert.bar.r#L184 更改：

# lpercentneg <- ddply(lpercentneg, .(Item), transform, 
  lpercentneg <- ddply(lpercentneg, .(Group, Item), transform,

然后取消注释这部分并从 if 语句中删除 FALSE

 # if(FALSE & plot.percents) { #TODO: implement for grouping
   if(plot.percents) {

这是 if 语句中的 sn-p：

# 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)
        }
    }

我没有做太多测试，但您的测试数据工作正常并产生以下输出：

我解决了这个问题并向 Jason 提交了一个拉取请求。与此同时，您可以从这里拉取更改：https://github.com/aseidlitz/likert

【讨论】：

这个答案的变化是incorporated into the package's Github repo in June 2017。但截至 2018 年 5 月发表评论时，该更新尚未发布到 CRAN，因此同时尝试使用 devtools::install_github("jbryer/likert") 从 Github 安装开发版本@
@SamFirke 即使从开发版本安装，这些更改似乎也无法解决问题。

【解决方案2】：

嘿，我试过了，但使用分组数据对我来说也不起作用。尽管plot.percent.low 和plot.percent.high 工作正常，但没有提及原因。除非其他人破解它，否则我所能做的就是使用plot() 而不是likert.bar.plot 和text() 提供解决方法

这里我只为所有三个组标记Agree 类别。

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

【讨论】：

【解决方案3】：

如果您不想费心修改源材料，我根据源代码编写了一个小插件。只需接受上面的答案并应用它。如果您使用它制作大量图表，那么将其放入用户功能应该不会太难。我一直在做一些工作，试图添加百分比，然后想办法在图表的某个地方添加 N。

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

【讨论】：

【解决方案4】：

即使是使用 pisaitems 数据的 likert 包文档中包含的示例脚本也无法正确绘制百分比标签。当您运行此代码时，它最终看起来如下图所示。

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)

【讨论】：