Для цикла хранить много матриц

Question

У меня есть data.frame с именем core.df_long, и его пример выглядит так:

       ID 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013
 1   6387   Aa   Ba   Ba  Baa  Caa    B    A  Baa  Baa    B   Ba    B    B    A   Ba    B  Caa   Ba
 2   6403    B  Caa  Caa    B  Caa  Caa  Caa  Caa    B  Caa  Caa  Caa    B    B    B    B    B    B
 3   6408    A   Ba   Ba  Baa  Baa   Ba    A    A    B   Ba    B    B   Ba   Ba   Ba  Baa   Ba    B
 4   6411    B   Ba    B   Ba   Ba    B  Caa  Caa    B   Ba    B    B  Caa    B   Ba  Caa    B   Ba

Я пытаюсь составить матрицы на один год, которые учитывают частоту перехода от одной буквенной оценки к другой.

Я занимался созданием матриц для каждого года вручную следующим образом:

На этом шаге выбираются два года, которые мне нужно проанализировать, с 1996 по 1997 год, и ID:

#1996–1997
core.df_long9697 <- core.df_long %>%
  select(`1996`, `1997`, ID)

Этот шаг подсчитывает частоту уникальных переходов от одной буквы к другой:

res9697 <- aggregate(core.df_long9697$ID, by=list(`1996`=core.df_long9697$`1996`, `1997`=core.df_long9697$`1997`),
                 FUN = function(x) count = length(x)) %>%
rename(Count = x) %>%
arrange_at(1:2, desc) %>%
arrange(match(`1996`, row.order),
      match(`1997`, row.order)) %>%
mutate(i = `1996`,
     j = `1997`) %>%
select(i, j, Count)

> res9697
     i   j Count
1   Aa   A     3
2   Aa Baa     4
3   Aa  Ba     1
4    A Baa     5
5    A  Ba     2
6  Baa  Aa     1
7  Baa   A     2
8  Baa Baa     7
9  Baa  Ba     6
10 Baa   B     5
11 Baa Caa     2
12  Ba   A     2
13  Ba Baa     4
14  Ba  Ba     8
15  Ba   B    12
16  Ba Caa     7
17   B   A     1
18   B Baa     3
19   B  Ba     8
20   B   B    23
21   B Caa    16
22 Caa Baa     1
23 Caa  Ba     1
24 Caa   B    12
25 Caa Caa    19

На этом шаге создается матрица с использованием xtabs для иллюстрации сводки переходов:

res9697 <- xtabs(Count~i+j, data = res9697)

> res9697
      j
i     Aa  A Baa Ba  B Caa
  Aa   0  3   4  1  0   0
  A    0  0   5  2  0   0
  Baa  1  2   7  6  5   2
  Ba   0  2   4  8 12   7
  B    0  1   3  8 23  16
  Caa  0  0   1  1 12  19

Как я мог бы создать цикл for, который будет хранить матрицу каждый год (1996–1997, 1997–1998, 1998–1999, ..., 2012–2013), используя шаги, которые я обрисовал выше?

Кроме того, как бы я считал три года? И четыре года, и так далее

Пример того, что я делал, чтобы рассмотреть 3 года, выглядит следующим образом:

core.df_long969798 <- core.df_long %>%
  select(`1996`, `1997`, `1998`, ID)
res969798 <- aggregate(core.df_long969798$ID, by=list(`1996`=core.df_long969798$`1996`, `1997`=core.df_long969798$`1997`, `1998`=core.df_long969798$`1998`),
                   FUN = function(x) count = length(x)) %>%
  rename(Count = x) %>%
  arrange_at(1:2, desc) %>%
  arrange(match(`1996`, row.order),
      match(`1997`, row.order),
      match(`1998`, row.order)) %>%
  mutate(ij = paste(`1996`, `1997`, sep = '-'),
     k = `1998`) %>%
  select(ij, k, Count)

res969798 <- xtabs(Count~ij+k, data = res969798); res969798

ij - буквенные оценки в 1996 и 1997 годах, а k - штат в 1998 году.

          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

Answer 1

Рассмотрите возможность создания списка фреймов данных или матриц с lapply, повторяющимся по seq вашего числа столбцов, используя основание R:

Данные

txt <- '      ID 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013
 1   6387   Aa   Ba   Ba  Baa  Caa    B    A  Baa  Baa    B   Ba    B    B    A   Ba    B  Caa   Ba
2   6403    B  Caa  Caa    B  Caa  Caa  Caa  Caa    B  Caa  Caa  Caa    B    B    B    B    B    B
3   6408    A   Ba   Ba  Baa  Baa   Ba    A    A    B   Ba    B    B   Ba   Ba   Ba  Baa   Ba    B
4   6411    B   Ba    B   Ba   Ba    B  Caa  Caa    B   Ba    B    B  Caa    B   Ba  Caa    B   Ba'

core.df_long <- read.table(text=txt, header=TRUE, stringsAsFactors=FALSE)

lapply + seq

df_list <- lapply(seq(2, ncol(core.df_long)-1), function(x) {      
  sub_df <- core.df_long[,c(1, x:(x+1))]
  agg_df <- setNames(aggregate(ID ~ ., sub_df, length), c("i", "j", "Count"))
})

head(df_list)
# [[1]]
#    i   j Count
# 1  A  Ba     1
# 2 Aa  Ba     1
# 3  B  Ba     1
# 4  B Caa     1
# 
# [[2]]
#     i   j Count
# 1  Ba   B     1
# 2  Ba  Ba     2
# 3 Caa Caa     1
# 
# [[3]]
#     i   j Count
# 1 Caa   B     1
# 2   B  Ba     1
# 3  Ba Baa     2
# 
# [[4]]
#     i   j Count
# 1  Ba  Ba     1
# 2 Baa Baa     1
# 3   B Caa     1
# 4 Baa Caa     1
# 
# [[5]]
#     i   j Count
# 1  Ba   B     1
# 2 Caa   B     1
# 3 Baa  Ba     1
# 4 Caa Caa     1
# 
# [[6]]
#     i   j Count
# 1   B   A     1
# 2  Ba   A     1
# 3   B Caa     1
# 4 Caa Caa     1

А для xtabs просто добавьте строку в анонимную функцию:

df_list <- lapply(seq(2, ncol(core.df_long)-1), function(x) {      
  sub_df <- core.df_long[,c(1, x:(x+1))]
  agg_df <- setNames(aggregate(ID ~ ., sub_df, length), c("i", "j", "Count"))
  xtabs(Count ~ i + j, data = agg_df)
})

head(df_list)

# [[1]]
#     j
# i    Ba Caa
#   A   1   0
#   Aa  1   0
#   B   1   1
# 
# [[2]]
#      j
# i     B Ba Caa
#   Ba  1  2   0
#   Caa 0  0   1
# 
# [[3]]
#      j
# i     B Ba Baa
#   B   0  1   0
#   Ba  0  0   2
#   Caa 1  0   0
# 
# [[4]]
#      j
# i     Ba Baa Caa
#   B    0   0   1
#   Ba   1   0   0
#   Baa  0   1   1
# 
# [[5]]
#      j
# i     B Ba Caa
#   Ba  1  0   0
#   Baa 0  1   0
#   Caa 1  0   1
# 
# [[6]]
#      j
# i     A Caa
#   B   1   1
#   Ba  1   0
#   Caa 0   1

Answer 2

Вы можете легко сделать это с помощью map или lapply, без необходимости в цикле:

library(tidyverse)

# First, I create your example data as a matrix. Depending on your data, this first step might look different.
data_raw <- matrix(c("ID", "1996", "1997", "1998", "1999", "2000", "2001", "2002", "2003", "2004", "2005", "2006", "2007", "2008", "2009", "2010", "2011", "2012", "2013",
  "6387", "Aa", "Ba", "Ba", "Baa", "Caa", "B", "A", "Baa", "Baa", "B", "Ba", "B", "B", "A", "Ba", "B", "Caa", "Ba",
  "6403", "B", "Caa", "Caa", "B", "Caa", "Caa", "Caa", "Caa", "B", "Caa", "Caa", "Caa", "B", "B", "B", "B", "B", "B",
  "6408", "A", "Ba", "Ba", "Baa", "Baa", "Ba", "A", "A", "B", "Ba", "B", "B", "Ba", "Ba", "Ba", "Baa", "Ba", "B",
  "6411", "B", "Ba", "B", "Ba", "Ba", "B", "Caa", "Caa", "B", "Ba", "B", "B", "Caa", "B", "Ba", "Caa", "B", "Ba"), nrow = 5, byrow = TRUE)

# Second, I drop the first row (the IDs) and the first line (the colnames), since we don't need them later on
data <- data_raw[-1, -1]

# Third, I map the xtab-command to the column-number in your data
map(seq(dim(data)[2] - 1), ~{
  out <- as_tibble(data[,.x:(.x + 1)]) %>%
    set_names(c("i", "j")) %>%
    count(i, j) %>%
    xtabs(n ~ i + j, data = .)
  return(out)
})
[[1]]
    j
i    Ba Caa
  A   1   0
  Aa  1   0
  B   1   1

[[2]]
     j
i     B Ba Caa
  Ba  1  1   0
  Caa 0  0   1
...

# Finallay, I assign all these list elements to xtab-objects
data_names <- data_raw[1, -1]
for (i in seq(length(data_out))) {
  assign(str_c("res", str_sub(data_names[i], start = -2), str_sub(data_names[i + 1], start = -2), sep = ""), data_out[[i]])
}

res0001
     j
i     B Ba Caa
  Ba  1  0   0
  Baa 0  1   0
  Caa 1  0   1

str(res0001)
 'xtabs' int [1:3, 1:3] 1 0 1 0 1 0 0 0 1
 - attr(*, "dimnames")=List of 2
  ..$ i: chr [1:3] "Ba" "Baa" "Caa"
  ..$ j: chr [1:3] "B" "Ba" "Caa"
 - attr(*, "call")= language xtabs(formula = n ~ i + j, data = .)

# A solution for three years
map(seq(dim(data)[2] - 2), ~{ # for four years the '-2' becomes '-3'
  out <- as_tibble(data[,.x:(.x + 2)]) %>% # for four years the '+2' becomes '+3'
    set_names(c("i", "j", "k")) %>% # for four years you have to add letter 'l'
    mutate(ij = str_c(i, j, sep = "-")) %>% # for four years it's 'ijk = str_c(i, j, k, sep = "-")
    count(ij, k) %>% # for four years it's 'ijk, l'
    xtabs(n ~ ij + k, data = .) # for four years it's 'n ~ ijk + l'
  return(out)
})