根据多个条件创建矩阵列表

Question

假设我有以下数据集：

cntry <-c(1,2,3,4,1,2,3,4,1,2,3,4)
year<-c(1990,1990,1990,1990,1991,1991,1991,1991,1992,1992,1992,1992)
exist<-c(1,1,0,0,1,1,1,0,1,1,1,1)
region<-c(1,2,2,1,1,2,2,1,1,2,2,1)

data<-data.frame(cntry,year,exist,region)
split.data<-split(data,data$year)

$`1990`
  cntry year exist region
1     1 1990     1      1
2     2 1990     1      2
3     3 1990     0      2
4     4 1990     0      1

$`1991`
  cntry year exist region
5     1 1991     1      1
6     2 1991     1      2
7     3 1991     1      2
8     4 1991     0      1

$`1992`
   cntry year exist region
9      1 1992     1      1
10     2 1992     1      2
11     3 1992     1      2
12     4 1992     1      1

cntry：国家，年份：观测年份，存在：一个国家是否实际存在，地区：该国家位于哪个地区

对于每一年，我想创建一个矩阵来指示两个国家（如果它们都存在）是否位于同一地区，并且最好也将其存储在一个列表中。

对于 1991 年，结果将如下所示（只有国家 2 和 3 确实存在并且位于同一地区）：

b<-matrix(NA, nrow=length(unique(cntry)), ncol=length(unique(cntry)))
colnames(b)<-unique(cntry)
rownames(b)<-unique(cntry)

for(j in 1:length(split.data$`1991`$cntry)){
    for(i in 1:length(split.data$`1991`$cntry)){
      if(split.data$`1991`$region[i]==split.data$`1991`$region[j]&split.data$`1991`$exist[i]==1&split.data$`1991`$exist[j]==1){
        b[j,i] <- 1
    } else{
        b[j,i]<-0
      }
    }
  }
diag(b)<-0

所有年份的输出都需要如下所示：

b
$`1990`
  1 2 3 4
1 0 0 0 0
2 0 0 0 0
3 0 0 0 0
4 0 0 0 0

$`1991`
  1 2 3 4
1 0 0 0 0
2 0 0 1 0
3 0 1 0 0
4 0 0 0 0

$`1992`
  1 2 3 4
1 0 0 0 1
2 0 0 1 0
3 0 1 0 0
4 1 0 0 0

我很难找到一种方法来包含年份维度（也用于存储结果），并且我还想知道 for 循环是否实际上是解决问题的有效方法。

任何输入都受到高度评价！

Answer 1

这是一种可能性，输出是一个列表（每年包含命名元素），其中包含每个区域的国家/地区的 data.frames 列表：

res = lapply(split(data, year), function(u){
    df = subset(u, exist==1, select=c("cntry", "region"))
    Filter(function(x) nrow(x)>1, split(df, df$region))
}) 
Filter(function(x) length(x)>0, res)

#$`1991`
#$`1991`$`2`
#  cntry region
#6     2      2
#7     3      2


#$`1992`
#$`1992`$`1`
#   cntry region
#9      1      1
#12     4      1

#$`1992`$`2`
#   cntry region
#10     2      2
#11     3      2

这样：

#> res$'1991'
#$`2`
#  cntry region
#6     2      2
#7     3      2

Answer 2

这是一个使用tcrossprod 的选项。使用lapply 循环遍历列表（“split.data”），对“exist”等于1 的数据集行进行子集化（x$exist==1），选择列（c('cntry', 'region')）以创建“x1”。将“cntry”列更改为因子并将级别指定为“数据”（factor(x$cntry, levels=lvls)）中“cntry”的唯一元素，获取“x1”的table，tcrossprod输出，并更改对角线为“0”。删除结果的属性是可选的。

 lvls <- unique(data$cntry)

 lst <- lapply(split.data, function(x) {
            x1 <- x[x$exist==1, c('cntry', 'region')]
            x1$cntry <- factor(x1$cntry, levels=lvls)
            tbl <- table(x1)
            t1 <- tcrossprod(tbl)
            diag(t1) <- 0
            names(dimnames(t1))<- NULL
            t1
             })

 lst
 #$`1990`
 #  1 2 3 4
 #1 0 0 0 0
 #2 0 0 0 0
 #3 0 0 0 0
 #4 0 0 0 0

 #$`1991`
 #  1 2 3 4
 #1 0 0 0 0
 #2 0 0 1 0
 #3 0 1 0 0
 #4 0 0 0 0

 #$`1992`
 #  1 2 3 4
 #1 0 0 0 1
 #2 0 0 1 0
 #3 0 1 0 0
 #4 1 0 0 0