在 R 中生成偏好矩阵?

Generate a Preference Matrix in R?

我正在使用 r 来分析以种族为属性的个人的无向网络。我想创建一个领带帐户 table 或 "preference matrix," 方阵,其中种族值在两个维度上排列,每个单元格告诉您有多少领带对应于该类型的关系。 (因此,您可以由此计算出一组与另一组打成平手的概率——但我只想将其用作 igraph 的 preference.game 函数中的参数)。这是我尝试过的:

# I create a variable for ethnicity by assigning the names of my vertices to their corresponding ethnicities

   eth <- atts$Ethnicity[match(V(mahmudNet)$name,atts$Actor)] 

# I create an adjacency matrix from my network data

   mat <- as.matrix(get.adjacency(mahmudNet))

# I create the dimensions for my preference matrix from the Ethnicity values

   eth.value <- unique(sort(eth))

# I create an empty matrix using these dimensions

eth.mat <- array(NA,dim=c(length(eth.value),length(eth.value)))

# I create a function that will populate the empty cells of the matrix

for (i in eth.value){
  for (j in eth.value){
    eth.mat[i,j] <- sum(mat[eth==i,eth==j])
  }
 }

我想我的问题在最后。我需要找出一个表达式来告诉 R 如何填充单元格。我输入的表达式似乎不起作用,但我想要它,这样我就可以去

a <- sum(mat[eth=="White", eth=="Black"])

然后 "a" 将 return 邻接矩阵中对应于白-黑关系的所有单元格的总和。

Here's a sample of my data:

# data frame with Ethnicity attributes:

                     Actor Ethnicity
1    Sultan Mahmud of Siak         2
2            Daeng Kemboja         1
3  Raja Kecik of Trengganu         1
4                Raja Alam         2
5                Tun Dalam         2
6                Raja Haji         1
7           The Suliwatang         1
8          Punggawa Miskin         1
9          Tengku Selangor         1
10        Tengku Raja Said         1
11         Datuk Bendahara         2
12                     VOC         3
13        King of Selangor         1
14        Dutch at Batavia         3
15            Punggawa Tua         2
16    Raja Tua Encik Andak         1
17      Raja Indera Bungsu         2
18         Sultan of Jambi         2
19            David Boelen         3
20        Datuk Temenggong         2
21      Punggawa Opu Nasti         1

# adjacency matrix with relations

                  Daeng Kemboja Punggawa Opu Nasti Raja Haji Daeng Cellak
Daeng Kemboja                  0                  1         1            1
Punggawa Opu Nasti             1                  0         1            0
Raja Haji                      1                  1         0            0
Daeng Cellak                   1                  0         0            0
Daeng Kecik                    1                  0         0            0
                   Daeng Kecik
Daeng Kemboja                1
Punggawa Opu Nasti           0
Raja Haji                    0
Daeng Cellak                 0
Daeng Kecik                  0

一旦您的数据处于正确的状态,这对 table 来说是一项简单的工作。

首先是一个示例数据集:

# fake ethnicity data by actor
actor_eth <- data.frame(actor = letters[1:10], 
                        eth = sample(1:3, 10, replace=T))

# fake adjacency matrix
adj_mat <- matrix(rbinom(100, 1, .5), ncol=10)
dimnames(adj_mat) <- list(letters[1:10],  letters[1:10])
# blank out lower triangle & diagonal, 
# so random data is not asymetric & no self-ties
adj_mat[lower.tri(adj_mat)] <- NA
diag(adj_mat) <- NA

这是我们的假邻接矩阵:

   a  b  c  d  e  f  g  h  i  j
a NA  1  1  1  0  0  1  1  0  1
b NA NA  0  1  0  1  0  0  1  0
c NA NA NA  1  1  0  0  1  0  0
d NA NA NA NA  1  0  0  1  1  0
e NA NA NA NA NA  0  0  1  0  1
f NA NA NA NA NA NA  1  1  0  1
g NA NA NA NA NA NA NA  1  1  0
h NA NA NA NA NA NA NA NA  0  0
i NA NA NA NA NA NA NA NA NA  1
j NA NA NA NA NA NA NA NA NA NA

这是我们的假 eth table:

   actor eth
1      a   3
2      b   3
3      c   3
4      d   2
5      e   1
6      f   3
7      g   3
8      h   3
9      i   1
10     j   2

所以你想要做的是 1) 把它放在长格式中,所以你有一堆包含源演员和目标演员的行,每行代表一个平局。然后 2) 将演员姓名替换为种族,因此您与 source/target 种族有联系。然后 3) 你可以只使用 table 来制作交叉表。

# use `melt` to put this in long form, omitting rows showing "non connections"
library(reshape2)
actor_ties <- subset(melt(adj_mat), value==1)

# now replace the actor names with their ethnicities to get create a data.frame
# of ties by ethnicty
eth_ties <- 
  data.frame(source_eth = with(actor_eth, eth[match(actor_ties$Var1, actor)]),
             target_eth = with(actor_eth, eth[match(actor_ties$Var2, actor)]))

# now here's your cross tab
table(eth_ties)

结果:

          target_eth
source_eth 1 2 3
         1 0 2 1
         2 2 0 1
         3 3 5 9