#r #list #matrix
#r #Список #матрица
Вопрос:
У меня есть список таблиц xtabs разной длины строк, но одинаковой длины столбцов. Имена строк представляют собой комбинации двух буквенных классов, например «A-B», а имена столбцов представляют собой однобуквенный класс, например «A». Я хотел бы сделать все матрицы одинакового размера, а затем добавить их.
Поскольку матрицы в списке имеют разные размеры, я знаю, что сначала мне нужно преобразовать их в одинаковые размеры, прежде чем я смогу их добавить. Я создал матрицу, которая содержит все возможные комбинации буквенных разрядов (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, как.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 = .)))
Комментарии:
1. Вы сделали это с помощью tidyverse? Там есть что-то, что вызывает ошибку (
Error in terms.formula(formula, data = data) : object '.' not found) при попытке присвоить этой структуре имя .2. Да, я использовал tidyverse.
3. Как насчет замены этого вывода выводом из
dput( head( lapply( data_out.2nd.ord, as.matrix), 3), чтобы интерпретатор R попытался найти исходный источник данных? И мы не получаем результат, содержащий 15 таблиц.4. @ 42- Я обновил вопрос с выводом.
Ответ №1:
Когда я пытаюсь вставить вывод dput из вопроса в R, он выдает ошибку, поэтому мы использовали ввод, показанный в Примечании в конце.
Вот два разных подхода.
1) zoo Устанавливает nms значение объединения имен строк, а затем преобразует каждую матрицу в zoo, используя ее имена строк в качестве индекса и объединяя каждый такой объект zoo с объектом zoo нулевой ширины, имеющим индекс nms . На этом этапе каждый объект 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
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}
Это должно быть довольно просто, потому что при извлечении строки может использоваться индексация символов, а затем и присвоение.
Затем выполните цикл for по элементам в data_out.2nd.ord , чтобы запустить эту функцию три раза.
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)
Комментарии:
1. Я добавил вывод
2. Глядя на мой код, мне интересно, можно ли сделать функцию addmat более эффективной? Возможно, просто:
function( inp, res){ res[ rownames(inp) ] <- inp; res}, и было бы векторизовано и, вероятно, более эффективно.