将不同维度的 xtab 矩阵标准化为同一维度答案

【问题标题】：Standardize xtab matrices of differing dimensions into the same dimension将不同维度的 xtab 矩阵标准化为同一维度
【发布时间】：2019-03-12 20:48:32
【问题描述】：

我有一个不同行长度但列长度相同的 xtabs 表列表。行名是两个字母等级的组合，例如“A-B”，列名是单个字母等级，例如“一种”。我想让所有矩阵都具有相同的维度，然后添加它们。

由于列表中的矩阵具有不同的维度，我知道我必须先将它们转换为相同的维度，然后才能添加它们。我创建了一个矩阵，其中包含所有可能的字母等级组合 (36 x 6)。如何使列表中的所有矩阵都具有与 36 x 6 矩阵相同的维度并确保遵守顺序？

row.order <- c( "Aa", "A",   "Baa", "Ba",  "B", "Caa")

# all possible combinations 
all.crossings <- expand.grid(row.order, row.order, row.order)

all.crossings <-
all.crossings %>% 
mutate(ij = paste(Var1, Var2, sep = "-"),
     k = Var2,
     Count = 0) %>%
select(ij, k, Count)

# use xtabs to transfor into matrix form
all.crossings <- xtabs(Count~ij+k, data = all.crossings)
attributes(all.crossings)$class <- "matrix"

这就是我的 xtab 矩阵列表的样子：

> data_out.2nd.ord
[[1]]
           k
ij        Aa  A Baa Ba  B Caa
  A-Ba     0  0   0  1  1   0
  A-Baa    0  0   2  1  2   0
  Aa-A     1  2   0  0  0   0
  Aa-Ba    0  0   0  1  0   0
  Aa-Baa   0  2   0  1  1   0
  B-A      0  0   0  1  0   0
  B-B      0  0   1  3 14   5
  B-Ba     0  0   1  1  3   3
  B-Baa    0  0   2  0  0   1
  B-Caa    0  0   1  3  5   7
  Ba-A     0  0   0  2  0   0
  Ba-B     0  0   2  5  3   2
  Ba-Ba    0  0   1  2  5   0
  Ba-Baa   0  1   0  1  1   1
  Ba-Caa   0  0   1  1  2   3
  Baa-A    0  0   0  2  0   0
  Baa-Aa   0  1   0  0  0   0
  Baa-B    0  0   0  2  1   2
  Baa-Ba   0  0   3  2  1   0
  Baa-Baa  1  0   3  2  1   0
  Baa-Caa  0  0   1  0  1   0
  Caa-B    0  0   0  0  6   6
  Caa-Ba   0  0   0  0  1   0
  Caa-Baa  0  0   1  0  0   0
  Caa-Caa  0  0   0  2  5  12

[[2]]
     k
ij        Aa  A Baa Ba  B Caa
  A-A      0  0   2  0  0   0
  A-Aa     0  1   0  0  0   0
  A-Ba     0  0   1  3  1   0
  Aa-A     0  1   0  0  0   0
  B-B      0  0   2  3 13   6
  B-Ba     0  0   2  4  3   1
  B-Baa    0  0   2  0  1   0
  B-Caa    0  0   1  1  8   5
  Ba-B     0  1   0  6  2   2
  Ba-Ba    1  2   2  1  1   0
  Ba-Baa   0  0   1  1  2   1
  Ba-Caa   0  0   0  2  0   1
  Baa-A    0  1   2  0  0   0
  Baa-Aa   0  1   0  0  0   0
  Baa-B    0  0   1  3  1   0
  Baa-Ba   0  1   2  1  1   0
  Baa-Baa  0  2   0  5  0   1
  Baa-Caa  0  0   0  1  1   0
  Caa-B    0  0   0  2  6   5
  Caa-Ba   0  0   1  2  0   3
  Caa-Baa  1  1   0  1  0   0
  Caa-Caa  0  0   0  1  7  14

[[3]]
     k
ij        Aa  A Baa Ba  B Caa
  A-A      0  0   0  1  1   0
  A-Baa    0  1   1  1  1   0
  Aa-A     0  2   0  0  0   0
  B-A      0  1   0  0  0   0
  B-B      0  0   2  3 14   3
  B-Ba     0  1   1  5  4   3
  B-Baa    0  0   2  0  1   0
  B-Caa    0  1   1  2  3   6
  Ba-A     0  0   2  0  1   0
  Ba-Aa    0  0   1  0  0   0
  Ba-B     0  0   0  2  2   2
  Ba-Ba    0  0   4  4  3   0
  Ba-Baa   0  0   2  2  2   2
  Ba-Caa   0  0   0  0  1   3
  Baa-A    0  0   3  0  0   0
  Baa-Aa   0  0   0  0  1   0
  Baa-B    0  0   0  2  0   1
  Baa-Ba   0  0   2  3  2   0
  Baa-Baa  0  0   2  0  1   0
  Baa-Caa  0  0   0  2  0   0
  Caa-B    0  0   0  0  9   7
  Caa-Ba   0  0   0  1  1   3
  Caa-Baa  0  0   0  1  0   0
  Caa-Caa  0  0   0  1  7  12

dput(head(lapply(data_out.2nd.ord, as.matrix),3))中的所有矩阵：

list(structure(c(0L, 0L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
2L, 0L, 2L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 1L, 0L, 
0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 2L, 0L, 0L, 0L, 0L, 1L, 1L, 2L, 
1L, 0L, 2L, 1L, 0L, 1L, 0L, 0L, 0L, 3L, 3L, 1L, 0L, 0L, 1L, 0L, 
1L, 1L, 0L, 1L, 1L, 1L, 3L, 1L, 0L, 3L, 2L, 5L, 2L, 1L, 1L, 2L, 
0L, 2L, 2L, 2L, 0L, 0L, 0L, 0L, 2L, 1L, 2L, 0L, 0L, 1L, 0L, 14L, 
3L, 0L, 5L, 0L, 3L, 5L, 1L, 2L, 0L, 0L, 1L, 1L, 1L, 1L, 6L, 1L, 
0L, 5L, 0L, 0L, 0L, 0L, 0L, 0L, 5L, 3L, 1L, 7L, 0L, 2L, 0L, 1L, 
3L, 0L, 0L, 2L, 0L, 0L, 0L, 6L, 0L, 0L, 12L), .Dim = c(25L, 6L
), .Dimnames = list(ij = c("A-Ba", "A-Baa", "Aa-A", "Aa-Ba", 
"Aa-Baa", "B-A", "B-B", "B-Ba", "B-Baa", "B-Caa", "Ba-A", "Ba-B", 
"Ba-Ba", "Ba-Baa", "Ba-Caa", "Baa-A", "Baa-Aa", "Baa-B", "Baa-Ba", 
"Baa-Baa", "Baa-Caa", "Caa-B", "Caa-Ba", "Caa-Baa", "Caa-Caa"
), k = c("Aa", "A", "Baa", "Ba", "B", "Caa")), class = c("xtabs", 
"table"), call = xtabs(formula = n ~ ij + k, data = .)), structure(c(0L, 
0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
0L, 0L, 0L, 1L, 0L, 0L, 1L, 0L, 1L, 0L, 0L, 0L, 0L, 1L, 2L, 0L, 
0L, 1L, 1L, 0L, 1L, 2L, 0L, 0L, 0L, 1L, 0L, 2L, 0L, 1L, 0L, 2L, 
2L, 2L, 1L, 0L, 2L, 1L, 0L, 2L, 0L, 1L, 2L, 0L, 0L, 0L, 1L, 0L, 
0L, 0L, 0L, 3L, 0L, 3L, 4L, 0L, 1L, 6L, 1L, 1L, 2L, 0L, 0L, 3L, 
1L, 5L, 1L, 2L, 2L, 1L, 1L, 0L, 0L, 1L, 0L, 13L, 3L, 1L, 8L, 
2L, 1L, 2L, 0L, 0L, 0L, 1L, 1L, 0L, 1L, 6L, 0L, 0L, 7L, 0L, 0L, 
0L, 0L, 6L, 1L, 0L, 5L, 2L, 0L, 1L, 1L, 0L, 0L, 0L, 0L, 1L, 0L, 
5L, 3L, 0L, 14L), .Dim = c(22L, 6L), .Dimnames = list(ij = c("A-A", 
"A-Aa", "A-Ba", "Aa-A", "B-B", "B-Ba", "B-Baa", "B-Caa", "Ba-B", 
"Ba-Ba", "Ba-Baa", "Ba-Caa", "Baa-A", "Baa-Aa", "Baa-B", "Baa-Ba", 
"Baa-Baa", "Baa-Caa", "Caa-B", "Caa-Ba", "Caa-Baa", "Caa-Caa"
), k = c("Aa", "A", "Baa", "Ba", "B", "Caa")), class = c("xtabs", 
"table"), call = xtabs(formula = n ~ ij + k, data = .)), structure(c(0L, 
0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 2L, 1L, 0L, 1L, 0L, 1L, 0L, 
0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
1L, 0L, 0L, 2L, 1L, 2L, 1L, 2L, 1L, 0L, 4L, 2L, 0L, 3L, 0L, 0L, 
2L, 2L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 0L, 0L, 3L, 5L, 0L, 2L, 0L, 
0L, 2L, 4L, 2L, 0L, 0L, 0L, 2L, 3L, 0L, 2L, 0L, 1L, 1L, 1L, 1L, 
1L, 0L, 0L, 14L, 4L, 1L, 3L, 1L, 0L, 2L, 3L, 2L, 1L, 0L, 1L, 
0L, 2L, 1L, 0L, 9L, 1L, 0L, 7L, 0L, 0L, 0L, 0L, 3L, 3L, 0L, 6L, 
0L, 0L, 2L, 0L, 2L, 3L, 0L, 0L, 1L, 0L, 0L, 0L, 7L, 3L, 0L, 12L
), .Dim = c(24L, 6L), .Dimnames = list(ij = c("A-A", "A-Baa", 
"Aa-A", "B-A", "B-B", "B-Ba", "B-Baa", "B-Caa", "Ba-A", "Ba-Aa", 
"Ba-B", "Ba-Ba", "Ba-Baa", "Ba-Caa", "Baa-A", "Baa-Aa", "Baa-B", 
"Baa-Ba", "Baa-Baa", "Baa-Caa", "Caa-B", "Caa-Ba", "Caa-Baa", 
"Caa-Caa"), k = c("Aa", "A", "Baa", "Ba", "B", "Caa")), class = c("xtabs", 
"table"), call = xtabs(formula = n ~ ij + k, data = .)))

【问题讨论】：

你是用 tidyverse 做的吗？当您尝试将该结构分配给名称时，其中的某些内容会导致错误 (Error in terms.formula(formula, data = data) : object '.' not found)。
是的，我用过 tidyverse。
用dput( head( lapply( data_out.2nd.ord, as.matrix), 3) 的输出替换那个输出怎么样，这样R 解释器会尝试找到原始数据源？而且我们没有得到包含 15 个表的输出。
@42- 我已经用输出更新了问题。

标签： r list matrix

【解决方案1】：

当我尝试将问题的 dput 输出粘贴到 R 中时，会出现错误，因此我们使用了末尾注释中显示的输入。

这里有两种不同的方法。

1) zoo 将nms 设置为行名的并集，然后使用其行名作为索引将每个矩阵转换为动物园，并将每个此类动物园对象与具有nms 的索引。此时每个动物园对象都具有相同的行名和列名。最后使用Reduce 将它们相加。

library(zoo)

nms <- Reduce(union, lapply(L, rownames))
Lz <- lapply(L, function(x) merge(zoo(x, rownames(x)), zoo(, nms), fill = 0))
m <- as.matrix(Reduce(`+`, Lz))
head(m)
##       Aa A Baa Ba B Caa
## A-A    0 0   2  1 1   0
## A-Aa   0 1   0  0 0   0
## A-Ba   0 0   1  4 2   0
## A-Baa  0 1   3  2 3   0
## Aa-A   1 5   0  0 0   0
## Aa-Ba  0 0   0  1 0   0

2) as.data.frame 使用as.data.frame将列表L的每个组件转换为长格式，aggregate生成的数据帧然后使用xtabs进行转换回到宽格式。

dd <- do.call("rbind", lapply(L, as.data.frame))
ag <- aggregate(Freq ~., dd, sum)
names(ag) <- c("ij", "k", "Freq")
xt <- xtabs(Freq ~., ag)
head(xt)
##         k
## ij       Aa A Baa Ba B Caa
##   A-Ba    0 0   1  4 2   0
##   A-Baa   0 1   3  2 3   0
##   Aa-A    1 5   0  0 0   0
##   Aa-Ba   0 0   0  1 0   0
##   Aa-Baa  0 2   0  1 1   0
##   B-A     0 1   0  1 0   0

注意

Lines1 <- " Aa  A Baa Ba  B Caa
  A-Ba     0  0   0  1  1   0
  A-Baa    0  0   2  1  2   0
  Aa-A     1  2   0  0  0   0
  Aa-Ba    0  0   0  1  0   0
  Aa-Baa   0  2   0  1  1   0
  B-A      0  0   0  1  0   0
  B-B      0  0   1  3 14   5
  B-Ba     0  0   1  1  3   3
  B-Baa    0  0   2  0  0   1
  B-Caa    0  0   1  3  5   7
  Ba-A     0  0   0  2  0   0
  Ba-B     0  0   2  5  3   2
  Ba-Ba    0  0   1  2  5   0
  Ba-Baa   0  1   0  1  1   1
  Ba-Caa   0  0   1  1  2   3
  Baa-A    0  0   0  2  0   0
  Baa-Aa   0  1   0  0  0   0
  Baa-B    0  0   0  2  1   2
  Baa-Ba   0  0   3  2  1   0
  Baa-Baa  1  0   3  2  1   0
  Baa-Caa  0  0   1  0  1   0
  Caa-B    0  0   0  0  6   6
  Caa-Ba   0  0   0  0  1   0
  Caa-Baa  0  0   1  0  0   0
  Caa-Caa  0  0   0  2  5  12"

Lines2 <- "Aa  A Baa Ba  B Caa
  A-A      0  0   2  0  0   0
  A-Aa     0  1   0  0  0   0
  A-Ba     0  0   1  3  1   0
  Aa-A     0  1   0  0  0   0
  B-B      0  0   2  3 13   6
  B-Ba     0  0   2  4  3   1
  B-Baa    0  0   2  0  1   0
  B-Caa    0  0   1  1  8   5
  Ba-B     0  1   0  6  2   2
  Ba-Ba    1  2   2  1  1   0
  Ba-Baa   0  0   1  1  2   1
  Ba-Caa   0  0   0  2  0   1
  Baa-A    0  1   2  0  0   0
  Baa-Aa   0  1   0  0  0   0
  Baa-B    0  0   1  3  1   0
  Baa-Ba   0  1   2  1  1   0
  Baa-Baa  0  2   0  5  0   1
  Baa-Caa  0  0   0  1  1   0
  Caa-B    0  0   0  2  6   5
  Caa-Ba   0  0   1  2  0   3
  Caa-Baa  1  1   0  1  0   0
  Caa-Caa  0  0   0  1  7  14"

Lines3 <- "Aa  A Baa Ba  B Caa
  A-A      0  0   0  1  1   0
  A-Baa    0  1   1  1  1   0
  Aa-A     0  2   0  0  0   0
  B-A      0  1   0  0  0   0
  B-B      0  0   2  3 14   3
  B-Ba     0  1   1  5  4   3
  B-Baa    0  0   2  0  1   0
  B-Caa    0  1   1  2  3   6
  Ba-A     0  0   2  0  1   0
  Ba-Aa    0  0   1  0  0   0
  Ba-B     0  0   0  2  2   2
  Ba-Ba    0  0   4  4  3   0
  Ba-Baa   0  0   2  2  2   2
  Ba-Caa   0  0   0  0  1   3
  Baa-A    0  0   3  0  0   0
  Baa-Aa   0  0   0  0  1   0
  Baa-B    0  0   0  2  0   1
  Baa-Ba   0  0   2  3  2   0
  Baa-Baa  0  0   2  0  1   0
  Baa-Caa  0  0   0  2  0   0
  Caa-B    0  0   0  0  9   7
  Caa-Ba   0  0   0  1  1   3
  Caa-Baa  0  0   0  1  0   0
  Caa-Caa  0  0   0  1  7  12"

t1 <- as.table(as.matrix(read.table(text = Lines1, strip.white = TRUE)))
t2 <- as.table(as.matrix(read.table(text = Lines2, strip.white = TRUE)))
t3 <- as.table(as.matrix(read.table(text = Lines3, strip.white = TRUE)))

L <- list(t1, t2, t3)

【讨论】：

【解决方案2】：

为它的主体创建一个包含此伪代码的 R 代码并返回修改后的 all.crossings 的函数：

for each rowname in data-matrix{
     add this row from datamatrix to matching row in all.crossings
                                }

实际代码：

addmat <- function(X, res){ for( r in rownames(X)) { res[r, ] <- X[r,]+res[r,] }; res}

这应该很容易，因为拉一行可以使用字符索引，然后赋值也可以。

然后对 data_out.2nd.ord 中的项目进行 for 循环以运行该函数 3 次。

 res <- all.crossings; for( s in seq_along(dat) ){  
                                    res <- addmat( dat[[s]], res=res) }

所提供数据的结果：

> res
         k
ij        Aa A Baa Ba  B Caa
  A-A      0 0   2  1  1   0
  A-Aa     0 1   0  0  0   0
  A-B      0 0   0  0  0   0
  A-Ba     0 0   1  4  2   0
  A-Baa    0 1   3  2  3   0
  A-Caa    0 0   0  0  0   0
  Aa-A     1 5   0  0  0   0
  Aa-Aa    0 0   0  0  0   0
  Aa-B     0 0   0  0  0   0
  Aa-Ba    0 0   0  1  0   0
  Aa-Baa   0 2   0  1  1   0
  Aa-Caa   0 0   0  0  0   0
  B-A      0 1   0  1  0   0
  B-Aa     0 0   0  0  0   0
  B-B      0 0   5  9 41  14
  B-Ba     0 1   4 10 10   7
  B-Baa    0 0   6  0  2   1
  B-Caa    0 1   3  6 16  18
  Ba-A     0 0   2  2  1   0
  Ba-Aa    0 0   1  0  0   0
  Ba-B     0 1   2 13  7   6
  Ba-Ba    1 2   7  7  9   0
  Ba-Baa   0 1   3  4  5   4
  Ba-Caa   0 0   1  3  3   7
  Baa-A    0 1   5  2  0   0
  Baa-Aa   0 2   0  0  1   0
  Baa-B    0 0   1  7  2   3
  Baa-Ba   0 1   7  6  4   0
  Baa-Baa  1 2   5  7  2   1
  Baa-Caa  0 0   1  3  2   0
  Caa-A    0 0   0  0  0   0
  Caa-Aa   0 0   0  0  0   0
  Caa-B    0 0   0  2 21  18
  Caa-Ba   0 0   1  3  2   6
  Caa-Baa  1 1   1  2  0   0
  Caa-Caa  0 0   0  4 19  38
attr(,"class")
[1] "matrix"
attr(,"call")
xtabs(formula = Count ~ ij + k, data = all.crossings)

【讨论】：

我已经添加了输出
查看我的代码我想知道函数 addmat 是否可以提高效率？也许只是：function( inp, res){ res[ rownames(inp) ] <- inp; res}，并且会被矢量化并且可能更有效。