从R中的posthoc Tukey可视化关键值/成对比较

我正试图从posthoc Tukey那里获得临界值的精细可视化。有一些用于可视化成对比较的方法，但我需要更精细的方法。我的想法是，我将绘制一个图，其中每个小正方形将代表下面矩阵中的一个临界值，编码方式如下：

• 如果该值大于或等于5.45，则为黑色正方形
• 如果该值小于或等于-5.45，则为灰色正方形
• 如果该值介于-5.65和5.65之间，则为白色正方形

数据矩阵为

或者你会有更好的建议，如何形象化这些关键价值观

---

编辑：以下是@Aaron和@DWin的评论，我想为上述数据提供更多的上下文，并为我的问题提供理由。我在看七个虚拟角色的平均可接受度评分，每个角色都有5个不同的动画级别。所以，我有两个因素-角色（7个层次）和动作（5个层次）。因为我发现了这两个因素之间的相互作用，所以我决定研究所有角色在所有运动水平上的平均值之间的差异，这导致了这个巨大的矩阵，作为posthoc Tukey的输出。现在可能有太多细节了，但请不要把我扔出去交叉验证，他们会把我活活吃掉

如果使用findInterval将其设置为

bg

、

col

、和/或

pch

参数的索引（尽管它们目前都是正方形），您应该会发现代码相当紧凑且易于理解

首先需要获取长格式的数据；这里有一个方法：

d <- as.matrix(read.table("http://dl.dropbox.com/u/2505196/postH.dat"))
dat <- within(as.data.frame(as.table(d)), 
              { Var1 <- as.numeric(Var1)  
                Var2 <- as.numeric(Var2) })

这里需要

1+

，因为值是0,1,2，索引需要从1开始

---

这是一个ggplot2解决方案。我相信有更简单的方法来实现这一点——我想我被迷住了

library(ggplot2)

# Load data.
postH = read.table("~/Downloads/postH.dat")
names(postH) = paste("item", 1:35, sep="") # add column names.
postH$item_id_x = paste("item", 1:35, sep="") # add id column.

# Convert data.frame to long form.
data_long = melt(postH, id.var="item_id_x", variable_name="item_id_y")

# Convert to factor, controlling the order of the factor levels.
data_long$item_id_y = factor(as.character(data_long$item_id_y), 
                        levels=paste("item", 1:35, sep=""))
data_long$item_id_x = factor(as.character(data_long$item_id_x), 
                        levels=paste("item", 1:35, sep=""))

# Create critical value labels in a new column.
data_long$critical_level = ifelse(data_long$value >= 5.45, "high",
                             ifelse(data_long$value <= -5.65, "low", "middle"))

# Convert to labels to factor, controlling the order of the factor levels.
data_long$critical_level = factor(data_long$critical_level,
                                  levels=c("high", "middle", "low"))

# Named vector for ggplot's scale_fill_manual
critical_level_colors = c(high="black", middle="grey80", low="white")

# Calculate grid line positions manually.
x_grid_lines = seq(0.5, length(levels(data_long$item_id_x)), 1)
y_grid_lines = seq(0.5, length(levels(data_long$item_id_y)), 1)

# Create plot.
plot_1 = ggplot(data_long, aes(xmin=as.integer(item_id_x) - 0.5,
                               xmax=as.integer(item_id_x) + 0.5,
                               ymin=as.integer(item_id_y) - 0.5,
                               ymax=as.integer(item_id_y) + 0.5,
                               fill=critical_level)) +
     theme_bw() +
     opts(panel.grid.minor=theme_blank(), panel.grid.major=theme_blank()) +
     coord_cartesian(xlim=c(min(x_grid_lines), max(x_grid_lines)),
                     ylim=c(min(y_grid_lines), max(y_grid_lines))) +
     scale_x_continuous(breaks=seq(1, length(levels(data_long$item_id_x))),
                        labels=levels(data_long$item_id_x)) +
     scale_y_continuous(breaks=seq(1, length(levels(data_long$item_id_x))),
                        labels=levels(data_long$item_id_y)) +
     scale_fill_manual(name="Critical Values", values=critical_level_colors) +
     geom_rect() +
     geom_hline(yintercept=y_grid_lines, colour="grey40", size=0.15) +
     geom_vline(xintercept=x_grid_lines, colour="grey40", size=0.15) +
     opts(axis.text.y=theme_text(size=9)) +
     opts(axis.text.x=theme_text(size=9, angle=90)) +
     opts(title="Critical Values Matrix")

# Save to pdf file.
pdf("plot_1.pdf", height=8.5, width=8.5)
print(plot_1)
dev.off()

库（ggplot2）
#加载数据。
postH=read.table（“~/Downloads/postH.dat”）
名称（postH）=粘贴（“项目”，1:35，sep=”“）#添加列名。
postH$item_id_x=粘贴（“item”，1:35，sep=”“）#添加id列。
#将data.frame转换为长格式。
数据长=melt（postH，id.var=“item\u id\u x”，variable\u name=“item\u id\u y”）
#转换为因子，控制因子级别的顺序。
data_long$item_id_y=因子（如.character（data_long$item_id_y）），
级别=粘贴（“项目”，1:35，sep=“”））
data_long$item_id_x=因子（如.character（data_long$item_id_x），
级别=粘贴（“项目”，1:35，sep=“”））
#在新列中创建临界值标签。
数据长$critical\u level=ifelse（数据长$value>=5.45，“高”，
ifelse（data_long$value这对于
图像来说相当简单：

d <- as.matrix(read.table("http://dl.dropbox.com/u/2505196/postH.dat"))    
image(x=1:35, y=1:35, as.matrix(d), breaks=c(min(d), -5.45, 5.45, max(d)), 
      col=c("grey", "white", "black"))

d为了结束本文，我使用了@DWin和@aron的大部分建议来创建下面的图。最浅的灰色表示无意义的值。我还使用
rect
在轴名称上方创建线条，以便更好地区分条件：

d <- as.matrix(read.table("http://dl.dropbox.com/u/2505196/postH.dat"))
#remove upper half of the values (as they are mirrored values)
d[upper.tri(d)] <- NA
dat <- within(as.data.frame(as.table(d)),{
Var1 <- as.numeric(Var1)
Var2 <- as.numeric(Var2)})
par(mar=c(6,3,3,6))
colPh=c("gray50","gray90","black")
plot(dat$Var1,dat$Var2,bg = colPh[1+findInterval(dat$Freq, c(-5.45,5.45))],
    col="white",cex=1.2,pch = 21,axes=F,xlab="",ylab="")
labDis <- rep(c("A","B","C","D","E"),times=7)
labChar <- c(1:7)
axis(1,at=1:35,labels=labDis,cex.axis=0.5,tick=F,line=-1.4)
axis(1,at=seq(3,33,5),labels=labChar, tick=F)
#drawing lines above axis for better identification
rect(1,0,5,0,angle=90);rect(6,0,10,0,angle=90);rect(11,0,15,0,angle=90);
rect(16,0,20,0,angle=90);rect(21,0,25,0,angle=90);rect(26,0,30,0,angle=90);
rect(31,0,35,0,angle=90)
axis(4,at=1:35,labels=labDis,cex.axis=0.5,tick=F,line=-1.4)
axis(4,at=seq(3,33,5),labels=labChar,tick=F)
#drawing lines above axis for better identification
rect(36,1,36,5,angle=90);rect(36,6,36,10,angle=90);rect(36,11,36,15,angle=90);
rect(36,16,36,20,angle=90);rect(36,21,36,25,angle=90);rect(36,26,36,30,angle=90);
rect(36,31,36,35,angle=90)
legend("topleft",legend=c("not significant","p<0.01","p<0.05"),pch=16,
col=c("gray90","gray50","black"),cex=0.7,bty="n")

d哇哦，这真是一个庞大的解决方案@bdemarest，但非常感谢您的努力。代码描述也很好。有一个问题-如何只显示矩阵的一半，对角切割？@Acid上的极客：我已经思考了一段时间，但我看不到一个简单的方法。我的解决方案似乎不是很通用/customizable！也许其他人对此有想法…你不能改用
gginvalization（）
吗？介意我编辑添加结果图片（代码稍微修改一下吗？）更好的建议取决于你试图用这些数据讲述的故事。通常情况下，人们会根据它们的平均值对级别进行排序，但似乎在级别中有一些具有特殊意义的模式；特别是，似乎每五个级别都可能相关（或不相关）以某种特定的方式。我也对可视化临界值持谨慎态度，因为这是一种统计意义的度量，因此隐藏了结果的实际意义（或缺乏）。来吧，你可以做到！发布你的第一个交叉验证问题……我敢问你！（真的，我们在那里没有那么可怕。）只要解释一下你的数据，你想知道什么，最重要的是，为什么你想知道。你不需要有答案，这就是你为什么要问这个问题。
d <- as.matrix(read.table("http://dl.dropbox.com/u/2505196/postH.dat"))
#remove upper half of the values (as they are mirrored values)
d[upper.tri(d)] <- NA
dat <- within(as.data.frame(as.table(d)),{
Var1 <- as.numeric(Var1)
Var2 <- as.numeric(Var2)})
par(mar=c(6,3,3,6))
colPh=c("gray50","gray90","black")
plot(dat$Var1,dat$Var2,bg = colPh[1+findInterval(dat$Freq, c(-5.45,5.45))],
    col="white",cex=1.2,pch = 21,axes=F,xlab="",ylab="")
labDis <- rep(c("A","B","C","D","E"),times=7)
labChar <- c(1:7)
axis(1,at=1:35,labels=labDis,cex.axis=0.5,tick=F,line=-1.4)
axis(1,at=seq(3,33,5),labels=labChar, tick=F)
#drawing lines above axis for better identification
rect(1,0,5,0,angle=90);rect(6,0,10,0,angle=90);rect(11,0,15,0,angle=90);
rect(16,0,20,0,angle=90);rect(21,0,25,0,angle=90);rect(26,0,30,0,angle=90);
rect(31,0,35,0,angle=90)
axis(4,at=1:35,labels=labDis,cex.axis=0.5,tick=F,line=-1.4)
axis(4,at=seq(3,33,5),labels=labChar,tick=F)
#drawing lines above axis for better identification
rect(36,1,36,5,angle=90);rect(36,6,36,10,angle=90);rect(36,11,36,15,angle=90);
rect(36,16,36,20,angle=90);rect(36,21,36,25,angle=90);rect(36,26,36,30,angle=90);
rect(36,31,36,35,angle=90)
legend("topleft",legend=c("not significant","p<0.01","p<0.05"),pch=16,
col=c("gray90","gray50","black"),cex=0.7,bty="n")