此类关系通常用列联表进行总结,如以下(随机)示例:
Col 1 Col 2 Col 3 Col 4
Row 1 3 6 40 34
Row 2 18 6 9 1
通常,我们有兴趣将这些数据与某些默认模型建议的值进行比较,例如独立行和列比例的空模型。在将数据与这些值进行比较时,实际计数很重要,因为它们与差异的方差成正比。
因此,良好的可视化将清楚地显示计数及其预期值,最好组织成与表格平行。
心理学家和统计学家的研究表明,色调和阴影等图形元素在描述数量等数量方面做得相对较差。尽管长度和位置往往是最清晰和最准确的,但它们仅适用于显示相对计数:即它们的比例。还不够好。
因此,我建议通过绘制个不同的、不重叠的大小相同的图形符号来表示任何计数,以便每个符号清楚地表示一个可计数的东西。为了使这项工作顺利进行,我的实验发现了以下内容:kk
将符号聚集成一个紧凑的对象似乎比在绘图区域内随机放置它们更好。
在面积代表期望值的多边形上叠加符号可以直接直观地比较计数与其期望值。与符号簇同心的矩形就足够了。
作为奖励,每个计数的标准误差与其平方根成正比,因此由其参考多边形的周长表示。虽然这很微妙,但很高兴看到如此有用的数量自然地出现在图形中。
人们倾向于彩色图形,但由于颜色可能无法再现(例如,想想研究期刊中的页面费用),我使用颜色来区分单元格,但不代表任何必要的东西。
这是上表的此解决方案的示例:
立即清楚哪些细胞的计数过大,哪些细胞的计数过小。我们甚至可以快速了解他们超出或低于预期的程度。通过一些练习,您可以学会从这样的图中观察卡方统计量。
我用通常的伴奏装饰了这个人物:左侧和顶部的行和列标签;右侧和底部的行和列总计;和检验的 p 值(在这种情况下,Fisher 的独立性精确检验是用一百万个模拟数据集计算的)。
为了比较,这里是随机分散符号的可视化:
因为符号不再聚集,所以绘制参考矩形是没有用的。相反,我使用单元格阴影来表示预期值。(越深越高。)虽然这种方法仍然有效,但我从第一个(集群)版本中得到了更多。
当对其中一个或两个变量进行排序时,如果行和列遵循排序,则相同的可视化效果是有效的。
最后,这适用于表。2×2 这是在对年龄歧视案件的分析中提出的,据称老年工人被优先解雇。确实,这张桌子看起来有点有罪,因为根本没有放过年轻人:
Old Young
Kept 135 26
Fired 14 0
然而,可视化表明在与年龄没有关系的零假设下,观察值与预期值之间的密切一致性:
Fisher 精确检验 p 值支持视觉印象。0.134
因为我知道人们会要求它,所以这里是R
用于生成数字的代码。
m <- 2
n <- 4
set.seed(17)
shape <- .8
mu <- 180 / (m*n)
x <- matrix(rpois(m*n, rgamma(m*n, shape, shape/mu)), m, n)
if (is.null(colnames(x))) colnames(x) <- paste("Col", 1:n)
if (is.null(rownames(x))) rownames(x) <- paste("Row", 1:m)
breaks.x <- seq(0, n, length.out=n+1)
breaks.y <- rev(seq(0, m, length.out=m+1))
#
# Testing.
#
p.value <- signif(fisher.test(x, simulate.p.value=TRUE, B=1e6)$p.value, 3)
print(x)
#
# Set up plotting parameters.
#
random <- TRUE
h <- sample.int(m*n)
colors <- matrix(hsv(h / length(h), 0.9, 0.8, 1/2), nrow(x), ncol(x))
eps <- (1 - 1/(1.08))/2 # (Makes the plotting area exactly the right size.)
lim <- c(eps, 1-eps)
plot(lim*n, lim*m, type="n", xaxt="n", yaxt="n", bty="n", xlab="", ylab="",
xaxs="r", yaxs="r", asp=m/n,
main=substitute(paste("A ", m %*% n, " Table"), list(m=m, n=n)))
mtext(bquote(italic(p)==.(p.value)), side=1, line=2)
#
# Expectations.
#
gamma <- 6/3 # (Values above 1 reduce the background contrast.)
p.row <- rowSums(x)/sum(x)
p.col <- colSums(x)/sum(x)
if (isTRUE(random)) {
for (i in 1:m) {
polygon(c(range(breaks.x), rev(range(breaks.x))), rep(breaks.y[0:1+i], each=2),
col=hsv(0,0,0, p.row[i]^gamma))
}
for (j in 1:n) {
polygon(breaks.x[c(j,j+1,j+1,j)], rep(range(breaks.y), each=2),
col=hsv(0,0,0, p.col[j]^gamma))
}
} else {
for (i in 1:m) {
for (j in 1:n) {
p <- p.row[i] * p.col[j]
h <- (1 - (breaks.y[i] - breaks.y[i+1]) * sqrt(p))/2
w <- (1 - (breaks.x[j+1] - breaks.x[j]) * sqrt(p))/2
polygon(c(breaks.x[j]+w, breaks.x[j+1]-w, breaks.x[j+1]-w, breaks.x[j]+w),
c(breaks.y[i+1]+w, breaks.y[i+1]+w, breaks.y[i]-w, breaks.y[i]-w),
col=hsv(0,0,1/2))
}
}
}
#
# Borders.
#
gray <- hsv(0,0,5/6)
invisible(sapply(breaks.x, function(x) lines(rep(x,2), range(breaks.y), col=gray)))
invisible(sapply(breaks.y, function(y) lines(range(breaks.x), rep(y,2), col=gray)))
polygon(c(range(breaks.x), rev(range(breaks.x))), rep(range(breaks.y), each=2))
#
# Labels.
#
at <- (breaks.y[-1] + breaks.y[-(m+1)])/2
mtext(rownames(x), at=at, side=2, line=1/4)
mtext(rowSums(x), at=at, side=4, line=1/4)
at <- (breaks.x[-1] + breaks.x[-(n+1)])/2
mtext(colnames(x), at=at, side=3, line=0)
mtext(colSums(x), at=at, side=1, line=1/4)
#
# Samples.
#
runif2 <- function(n, ncol, nrow, lower.x=0, upper.x=1, lower.y=0, upper.y=1, random=TRUE) {
if (n > nrow*ncol) {
warning("Unable to generate enough samples")
n <- nrow*ncol
}
if (isTRUE(random)) {
i <- sample.int(nrow*ncol, n) - 1
} else {
# i <- seq_len(n) - 1
k <- order(outer(nrow*(1:ncol-(ncol+1)/2), ncol*(1:nrow-(nrow+1)/2), function(x,y) x^2+y^2))
i <- k[seq_len(n)] - 1
}
j <- (i %% ncol + 1/2) / ncol * (upper.y - lower.y) + lower.y
i <- (i %/% ncol + 1/2) / nrow * (upper.x - lower.x) + lower.x
cbind(i,j)
}
### Adjust the `400` to make the symbols barely overlap ###
cex <- 1 / sqrt(max(x)/400*max(m,n))
eps.x <- eps.y <- 0.05
u <- sqrt(max(x)/ (m*n))
u <- ceiling(u)
for (i in 1:m) {
for (j in 1:n) {
points(runif2(x[i,j], ceiling(m*u), ceiling(n*u),
breaks.x[j]+eps.x, breaks.x[j+1]-eps.x,
breaks.y[i+1]+eps.y, breaks.y[i]-eps.y,
random=random),
pch=22, cex=cex, col=colors[i,j], bg=colors[i,j])
}
}