r - 使用净堆积条形图可视化李克特 react : how to compare between groups?

Question

我借鉴了 上的这个优秀条目如何使用 R 可视化李克特响应:

[ https://stats.stackexchange.com/questions/25109/visualizing-likert-responses-using-r-or-spss ]

虽然这个问题的答案非常有帮助，但我没有设法 比较一个地 block 内的组 . (如果这不起作用)如果您帮助我将多个图组合成一个整体图，我将不胜感激。

非常感谢!

#需要的包裹#

install.packages(c('devtools', 'roxygen2', 'RSQLite', 'ipeds','reshape'), repos=c('http://cran.r-project.org', 'http://r-forge.r-project.org'))
require(devtools)
require(roxygen2)

library(ggplot2)
library(HH)
library(reshape)
library(gridExtra)

#生成类似于我使用的样本数据的代码，即通过 5 点李克特量表 (col2) 测量的多个陈述项目 (col1)，具有分组变量 (col3) 和频率响应 (col4; I设置均值和标准差，使数字为正数)。#

mydata1<-expand.grid(col1=c('item1', 'item2', 'item3', 'item4'), col2=c('0', '1', '2', '3', '4'), col3=c('T1'))
m<-2:7
s<-0:1
mydata1$col4=sapply(rnorm(20,m,s), function(x) {round(x,2)})
mydata1$col2<-factor(mydata1$col2, levels=c(0,1,2,3,4), labels=c("strongly disagree", "disagree", "neutral", "agree", "strongly agree"), ordered=TRUE)
mydata1<-reshape(mydata1, direction="wide", v.names="col4", timevar="col2", idvar="col1")

mydata2<-expand.grid(col1=c('item1', 'item2', 'item3', 'item4'),col2=c('0', '1', '2', '3', '4'),col3=c('T0'))
m<-2:7
s<-0:1
mydata2$col4=sapply(rnorm(20,m,s), function(x) {round(x,2)})
mydata2$col2<-factor(mydata2$col2, levels=c(0,1,2,3,4),labels=c("strongly disagree", "disagree", "neutral", "agree", "strongly agree"), ordered=TRUE)
mydata2<-reshape(mydata2, direction="wide", v.names="col4", timevar="col2", idvar="col1")

mydata3<-expand.grid(col1=c('item1', 'item2', 'item3', 'item4'),col2=c('0', '1', '2', '3', '4'),col3=c('C1'))
m<-2:7
s<-0:1
mydata3$col4=sapply(rnorm(20,m,s), function(x) {round(x,2)})
mydata3$col2<-factor(mydata3$col2,levels=c(0,1,2,3,4),labels=c("strongly disagree", "disagree", "neutral", "agree", "strongly agree"), ordered=TRUE)
mydata3<-reshape(mydata3, direction="wide", v.names="col4", timevar="col2", idvar="col1")

mydata4<-expand.grid(col1=c('item1', 'item2', 'item3', 'item4'),col2=c('0', '1', '2', '3', '4'),col3=c('C0'))
m<-2:7
s<-0:1
mydata4$col4=sapply(rnorm(20,m,s), function(x) {round(x,2)})
mydata4$col2<-factor(mydata4$col2,levels=c(0,1,2,3,4), labels=c("strongly disagree", "disagree", "neutral", "agree", "strongly agree"), ordered=TRUE)
mydata4<-reshape(mydata4, direction="wide", v.names="col4", timevar="col2", idvar="col1")

mydata<-rbind(mydata1, mydata2, mydata3, mydata4)
summary(mydata)

#准备资料#

mydata$col4.neutral<-NULL
colnames(mydata)[colnames(mydata)=="col4.strongly disagree"]<-"Strongly disagree"
colnames(mydata)[colnames(mydata)=="col4.disagree"]<-"Disagree"
colnames(mydata)[colnames(mydata)=="col4.agree"]<-"Agree"
colnames(mydata)[colnames(mydata)=="col4.strongly agree"]<-"Strongly agree"

#绘图#

items<-mydata[, c("Strongly disagree", "Disagree", "Agree", "Strongly agree")]
itemsg=likert(items, grouping =mydata$col3) 
plot(itemsg)

问题:该代码会生成一个图，但不会在组之间进行比较。似乎它绘制了 中出现的每个项目我的数据 因此，如果我们设法对行重新排序，我们可能能够生成一个图，以便在项目和组之间进行轻松比较。

> ro.mydata
            col1 col3 Strongly disagree Disagree Agree Strongly agree
item1 (T1) item1   T1              2.00     6.00  2.00           6.00
item1 (T0) item1   T0              2.00     6.00  2.00           6.00
item2 (T1) item2   T1              1.90     6.59  2.67           8.33
item2 (T0) item2   T0              3.57     6.76  3.23           9.03
item3 (T1) item3   T1              4.00     2.00  4.00           2.00
item3 (T0) item3   T0              4.00     2.00  4.00           2.00
item4 (T1) item4   T1              7.02     2.66  6.31           2.76
item4 (T0) item4   T0              3.56     3.63  4.74           3.21
item1 (C1) item1   C1              2.00     6.00  2.00           6.00
item1 (C0) item1   C0              2.00     6.00  2.00           6.00
item2 (C1) item2   C1              4.01     6.87  2.62           6.23
item2 (C0) item2   C0              2.95     5.95  3.69           5.36
item3 (C1) item3   C1              4.00     2.00  4.00           2.00
item3 (C0) item3   C0              4.00     2.00  4.00           2.00
item4 (C1) item4   C1              4.10     2.54  6.12           2.62
item4 (C0) item4   C0              4.57     1.94  3.64           2.86
>

Answer 1

所以，这有点超出了我的专业知识，因为底层函数使用了 R 中的格子绘图功能，而我并没有真正使用它。话虽如此，我相信有一种方法可以通过使用 by() 来完成你想要的。处理 likert() 的每个调用，然后使用布局参数将它们绘制在一个图中。

从...开始:

items_byg <- by(data=mydata[3:6],
                INDICES=mydata[2],
                FUN=likert,
                main="",xlab="",auto.key=list(columns=1,space="right"))

这会对您的数据框进行分组处理 - 数据是四个变量 mydata[3:6] ，索引为 mydata[2] , 函数为 likert() (来自 HH 包)。然后，将附加参数传递给 likert() - 即，使主情节标题为空白，x-labels 为空白，并将自动生成的 key 更改为右侧。我并不完全熟悉 auto.key 的参数，但是 ?barchart会提供一些信息。

下一个:

print(items_byg[[1]],position=c(0,0.75,1,1),more=TRUE)
print(items_byg[[2]],position=c(0,0.5,1,0.75),more=TRUE)
print(items_byg[[3]],position=c(0,0.25,1,0.5),more=TRUE)
print(items_byg[[4]],position=c(0,0,1,0.25))

by() 的输出将是一个列表，其中每个元素都是该组变量的格子对象。因此，我们只是将它们中的每一个打印到一个图上。如您所见，前三个有 more=TRUE ，它告诉 R 期待额外的情节。每个还有一个参数 position=c(x1,y1,x2,y2) .基本上，每个位置参数都给出了每个图的左下角和右上角的坐标。更多信息可从 this SO answer 获得.

其结果是所附的情节。到目前为止，它并不完美，但我认为这是一个开始。请注意，您可以更改 by()如果您想直观地比较各组之间的每个问题，请按问题分组，而不是按组。

显然，您仍然需要解决一些问题，例如使所有内容排列整齐并消除重复的键-那里存在一些挑战-但原则上，我相信这可以实现您想要的-很好地分组和堆叠的条形图。



编辑添加

在查看了您所说的内容后，我做了一些我认为对您有用的调整。从按项目排序数据开始:

mydata <- mydata[order(mydata[1]),]

接下来，我们还是使用 by()得到组，但有一些变化。首先，我们使用项目作为索引，而不是组(因为您想直观地比较组)。因此，生成的每个图都将围绕一个项目。我们设置 ylab是“组”，我们使用比例尺用组名称标记 y 轴。

items_byg <- by(data=mydata[3:6],
                INDICES=mydata[1],
                FUN=likert,
                main="",xlab="",ylab="Groups",auto.key=list(columns=1,space="right"),
                scales=list(y=list(labels=mydata[[2]])))

现在，我们可以使用循环来运行绘图。我们从 1 循环到倒数第二个图(因为它是最后一个图，我们需要删除 more=TRUE 。位置是棘手的部分，但即使这样也不算太糟糕。x1 总是为零，x2总是 1(左下角和右上角)。我们通过取 1(项目的顶部)减去 x*1/dim(items_byg) 得到 y1 的值。所以，如果你有 5 个项目，第一个有它下角在 1-(1)(1/5)，即 0.8。第二个在 1-(2)(1/5)，即 0.6，依此类推。y2 仅比 y1 大一维 (因此，如果 y1 为 0.8，则 y2 应为 1.0，依此类推)。我们还根据 x 为每个项目添加一个项目标题，然后将所有内容提供给打印。

for(x in 1:(dim(items_byg)-1)) {

    x1 <- 0
    y1 <- 1-(x*(1/dim(items_byg)))
    x2 <- 1
    y2 <- y1+(1/dim(items_byg))

    items_byg[[x]]$main <- paste("Item",x,sep=" ")
    print(items_byg[[x]],position=c(x1,y1,x2,y2),more=TRUE)
}

最后一点是完成最后的情节——创建一个项目编号，然后做最后的 print() (需要分开，这样你就不会得到另一个 more= 。

items_byg[[dim(items_byg)]]$main <- paste("Item",dim(items_byg),sep=" ")
print(items_byg[[dim(items_byg)]],position=c(0,0,1,0+(1/dim(items_byg))))

运行这个，我得到下面的图像，它应该很容易推广到多个项目。