R 将不同维度的xtab矩阵标准化为相同维度
我有一个不同行长但相同列长的xtabs表列表。行名称是两个字母等级的组合,例如“A-B”,列名是一个字母等级,例如“A”。我想让所有矩阵都具有相同的维数,然后将它们相加 由于列表中的矩阵具有不同的维度,我知道我必须先将它们转换为相同的维度,然后才能添加它们。我创建了一个矩阵,其中包含所有可能的字母等级组合(36 x 6)。如何使列表中的所有矩阵具有与36 x 6矩阵相同的维度,并确保遵守顺序R 将不同维度的xtab矩阵标准化为相同维度,r,list,matrix,R,List,Matrix,我有一个不同行长但相同列长的xtabs表列表。行名称是两个字母等级的组合,例如“A-B”,列名是一个字母等级,例如“A”。我想让所有矩阵都具有相同的维数,然后将它们相加 由于列表中的矩阵具有不同的维度,我知道我必须先将它们转换为相同的维度,然后才能添加它们。我创建了一个矩阵,其中包含所有可能的字母等级组合(36 x 6)。如何使列表中的所有矩阵具有与36 x 6矩阵相同的维度,并确保遵守顺序 row.order <- c( "Aa", "A", "Baa", "Ba", "B", "
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"
dput中的所有矩阵(头(lappy(data_out.2nd.ord,as.matrix),3)):
创建一个函数,该函数的主体具有此伪代码的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}
所提供数据的结果:
> 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)
当我试图将问题的dput输出粘贴到R中时,它给出了一个错误,因此我们使用了最后注释中显示的输入 这里有两种不同的方法 1)zoo将
nms
设置为行名的并集,然后使用其行名作为索引将每个矩阵转换为zoo,并将每个此类zoo对象与索引为nms
的零宽度zoo对象合并。此时,每个zoo对象都具有相同的行和列名。最后使用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
注
Lines1我已经添加了输出查看我的代码,我想知道addmat函数是否可以更高效?也许只是:function(inp,res){res[rownames(inp)]你是用tidyverse做的吗?里面有些东西会导致错误(error in terms.formula(formula,data=data):object.”找不到
)当您尝试将该结构分配给一个名称时。是的,我使用了tidyverse。用dput(head(lappy(data\u out.2nd.ord,as.matrix),3)的输出替换该输出如何?
所以R解释器确实尝试查找原始数据源?我们没有得到包含15个表的输出。@42-我已经用输出更新了问题。
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)
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
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)