如何使用 R 为 McNemar sig 测试压缩矩阵？

Question

我有一些调查数据，我希望测试其重要性，特别是在两个问题（a2 和 a3）之间。两个问题之间的样本不是相互排斥的，所以我希望应用 mcnemar 测试。响应矩阵为：

我需要测试在 a3 中选择 a 的人与在 a2 中选择 a 的人、在 a3 中选择 b 的人与在 a2 中选择 b 的人等之间的显着性。现在我正在手动创建 2x2 矩阵并使用mcnemar.test(matrix)，例如 e vs e 的 2x2 矩阵是

但我的问题是有没有办法创建一个循环或一些过程来更有效地创建这些矩阵？

Answer 1

你可以这样做：

mat <- matrix(c(16, 7, 3, 0, 23, 1, 9, 1, 0, 22, 3, 1, 11, 0, 22, 0, 0, 0, 0, 1, 21, 7, 9, 1, 67), 
              ncol = 5, 
              dimnames = list(c("a", "b", "c", "d", "e"), 
                              c("a", "b", "c", "d", "e")))

mat2 <- matrix(c(sum(mat[1:4,1:4]), sum(mat[5,1:4]), 
                 sum(mat[1:4,5]), mat[5,5]),
               ncol = 2,
               dimnames = list(c("a-d", "e"), c("a-d", "e")))

mat2
#>     a-d  e
#> a-d  52 38
#> e    68 67

或者推广到任意方阵NxN (N > 1)

to_2x2 <- function(mat) {
  # assume square matrix
  stopifnot(nrow(mat) == ncol(mat))
  n <- nrow(mat)
  stopifnot(n > 1)
  
  # extra processing for dimnames omitted
  
  matrix(c(sum(mat[1:(n-1),1:(n-1)]), 
           sum(mat[n,1:(n-1)]), 
           sum(mat[1:(n-1),n]), 
           mat[n,n]), ncol = 2)
}

to_2x2(mat)
#>      [,1] [,2]
#> [1,]   52   38
#> [2,]   68   67

---

从预先列出的数据开始：

## start with example tabulated counts
mat <- matrix(c(16, 7, 3, 0, 23, 1, 9, 1, 0, 22, 3, 1, 11, 0, 22, 0, 0, 0, 0, 1, 21, 7, 9, 1, 67), 
              ncol = 5, 
              dimnames = list(c("a", "b", "c", "d", "e"), 
                              c("a", "b", "c", "d", "e")))

## generate pre-tabulated data
a2 <- character(0)
a3 <- character(0)
for (i in seq.int(nrow(mat))) {
  for (j in seq.int(ncol(mat))) {
    a2 <- c(a2, rep(rownames(mat)[i], mat[i,j]))
    a3 <- c(a3, rep(rownames(mat)[j], mat[i,j]))
  }
}

pretab_dat <- data.frame(a2 = a2, a3 = a3)

## derive 2x2 tabulations
labels = unique(c(pretab_dat$a2, pretab_dat$a3))
tabs_2x2 = list()

for (i in seq_along(labels)) {
  others <- setdiff(labels, labels[i])  # all other labels except current
  others_name <- paste(others, collapse = "|")
  
  # re-label orig data
  temp <- transform(pretab_dat,
                    a2 = ifelse(a2 %in% others, others_name, a2),
                    a3 = ifelse(a3 %in% others, others_name, a3))
  
  # tabulate re-labeled data
  tabs_2x2[[i]] <- xtabs(~ a2 + a3, data = temp)
}

tabs_2x2
#> [[1]]
#>          a3
#> a2          a b|c|d|e
#>   a        16      25
#>   b|c|d|e  33     151
#> 
#> [[2]]
#>          a3
#> a2        a|c|d|e   b
#>   a|c|d|e     177  24
#>   b            15   9
#> 
#> [[3]]
#>          a3
#> a2        a|b|d|e   c
#>   a|b|d|e     175  26
#>   c            13  11
#> 
#> [[4]]
#>          a3
#> a2        a|b|c|e   d
#>   a|b|c|e     223   1
#>   d             1   0
#> 
#> [[5]]
#>          a3
#> a2        a|b|c|d  e
#>   a|b|c|d      52 38
#>   e            68 67