r - 强制 `table` 包含 R 中两个数组的所有因子

Question

我使用以下 R 代码生成一个混淆矩阵，将某些数据的真实标签与神经网络的输出进行比较。

t <- table(as.factor(test.labels), as.factor(nnetpredict))

但是，有时神经网络不会预测任何特定类别，因此表格不是方形的(例如，test.labels 因子中有 5 个级别，但 nnetpredict 中只有 3 个级别)因素)。我想通过添加任何必要的因子水平并将其计数设置为零来使表格成为正方形。

我应该怎样做呢？

示例:

> table(as.factor(a), as.factor(b))

    1 2 3 4 5 6 7 8 9 10
  1 1 0 0 0 0 0 0 1 0  0
  2 0 1 0 0 0 0 0 0 1  0
  3 0 0 1 0 0 0 0 0 0  1
  4 0 0 0 1 0 0 0 0 0  0
  5 0 0 0 0 1 0 0 0 0  0
  6 0 0 0 0 0 1 0 0 0  0
  7 0 0 0 0 0 0 1 0 0  0

您可以在上表中看到，有 7 行，但有 10 列，因为 a 因子只有 7 个级别，而 b 因子有 10 个级别。我想要做的是用零填充表格，以便行标签和列标签相同，并且矩阵是正方形的。从上面的示例中，这将产生:

    1 2 3 4 5 6 7 8 9 10
  1  1 0 0 0 0 0 0 1 0  0
  2  0 1 0 0 0 0 0 0 1  0
  3  0 0 1 0 0 0 0 0 0  1
  4  0 0 0 1 0 0 0 0 0  0
  5  0 0 0 0 1 0 0 0 0  0
  6  0 0 0 0 0 1 0 0 0  0
  7  0 0 0 0 0 0 1 0 0  0
  8  0 0 0 0 0 0 0 0 0  0
  9  0 0 0 0 0 0 0 0 0  0
  10 0 0 0 0 0 0 0 0 0  0

我需要这样做的原因有两个:

• 用于向用户显示/在报告中显示
• 这样我就可以使用函数来计算 Kappa 统计量，这需要一个如下格式的表格(方形、相同行和列标签)

Answer 1

编辑 - 第二轮以解决问题中的其他细节。我删除了我的第一个答案，因为它不再相关。

这已经为我给出的测试用例生成了所需的输出，但我绝对建议使用您的真实数据进行彻底测试。这里的方法是找到表中两个输入的完整级别列表，并在生成表之前将该完整列表设置为级别。

squareTable <- function(x,y) {
    x <- factor(x)
    y <- factor(y)

    commonLevels <- sort(unique(c(levels(x), levels(y))))

    x <- factor(x, levels = commonLevels)
    y <- factor(y, levels = commonLevels)

    table(x,y)

}

两个测试用例:

> #Test case 1
> set.seed(1)
> x <- factor(sample(0:9, 100, TRUE))
> y <- factor(sample(3:7, 100, TRUE))
> 
> table(x,y)
   y
x   3 4 5 6 7
  0 2 1 3 1 0
  1 1 0 2 3 0
  2 1 0 3 4 3
  3 0 3 6 3 2
  4 4 4 3 2 1
  5 2 2 0 1 0
  6 1 2 3 2 3
  7 3 3 3 4 2
  8 0 4 1 2 4
  9 2 1 0 0 3
> squareTable(x,y)
   y
x   0 1 2 3 4 5 6 7 8 9
  0 0 0 0 2 1 3 1 0 0 0
  1 0 0 0 1 0 2 3 0 0 0
  2 0 0 0 1 0 3 4 3 0 0
  3 0 0 0 0 3 6 3 2 0 0
  4 0 0 0 4 4 3 2 1 0 0
  5 0 0 0 2 2 0 1 0 0 0
  6 0 0 0 1 2 3 2 3 0 0
  7 0 0 0 3 3 3 4 2 0 0
  8 0 0 0 0 4 1 2 4 0 0
  9 0 0 0 2 1 0 0 3 0 0
> squareTable(y,x)
   y
x   0 1 2 3 4 5 6 7 8 9
  0 0 0 0 0 0 0 0 0 0 0
  1 0 0 0 0 0 0 0 0 0 0
  2 0 0 0 0 0 0 0 0 0 0
  3 2 1 1 0 4 2 1 3 0 2
  4 1 0 0 3 4 2 2 3 4 1
  5 3 2 3 6 3 0 3 3 1 0
  6 1 3 4 3 2 1 2 4 2 0
  7 0 0 3 2 1 0 3 2 4 3
  8 0 0 0 0 0 0 0 0 0 0
  9 0 0 0 0 0 0 0 0 0 0
> 
> #Test case 2
> set.seed(1)
> xx <- factor(sample(0:2, 100, TRUE))
> yy <- factor(sample(3:5, 100, TRUE))
> 
> table(xx,yy)
   yy
xx   3  4  5
  0  4 14  9
  1 14 15  9
  2 11 11 13
> squareTable(xx,yy)
   y
x    0  1  2  3  4  5
  0  0  0  0  4 14  9
  1  0  0  0 14 15  9
  2  0  0  0 11 11 13
  3  0  0  0  0  0  0
  4  0  0  0  0  0  0
  5  0  0  0  0  0  0
> squareTable(yy,xx)
   y
x    0  1  2  3  4  5
  0  0  0  0  0  0  0
  1  0  0  0  0  0  0
  2  0  0  0  0  0  0
  3  4 14 11  0  0  0
  4 14 15 11  0  0  0
  5  9  9 13  0  0  0