将数据框转换为 r 中的扩展矩阵

Question

假设我有以下数据框：

dfx <- data.frame(Var1=c("A", "B", "C", "D", "B", "C", "D", "C", "D", "D"),
           Var2=c("E", "E", "E", "E", "A", "A", "A", "B", "B", "C"),
           Var1out = c(1,-1,-1,-1,1,-1,-1,1,-1,-1),
           Var2out= c(-1,1,1,1,-1,1,1,-1,1,1))

dfx

   Var1 Var2 Var1out Var2out
1     A    E       1      -1
2     B    E      -1       1
3     C    E      -1       1
4     D    E      -1       1
5     B    A       1      -1
6     C    A      -1       1
7     D    A      -1       1
8     C    B       1      -1
9     D    B      -1       1
10    D    C      -1       1

您在此处看到的是 10 行，对应于玩家 A、B、C、D 和 E 之间的对决。他们互相比赛一次，每次对战的获胜者用 +1 表示，失败者表示每场比赛的比赛由 -1 表示（放入相应的列 Player Var1 结果为 Var1out，Player Var2 结果为 Var2out）。

所需的输出。

我希望将这个数据帧转换成这个输出矩阵（行的顺序对我来说并不重要，但是正如你所看到的，每一行都代表一个唯一的匹配）：

       A     B     C     D     E
1      1     0     0     0    -1
2      0    -1     0     0     1
3      0     0    -1     0     1
4      0     0     0    -1     1
5     -1     1     0     0     0
6      1     0    -1     0     0
7      1     0     0    -1     0
8      0    -1     1     0     0
9      0     1     0    -1     0
10     0     0     1    -1     0

我做了什么：

我设法以迂回的方式制作了这个矩阵。由于迂回的方式往往很慢且不太令人满意，我想知道是否有人能找到更好的方式。

我首先确保包含玩家的两个列的因子级别包含所有可能出现的玩家（例如，您会注意到玩家 E 从未出现在 Var1 中）。

#  Making sure Var1 and Var2 have same factor levels
levs <- unique(c(levels(dfx$Var1), levels(dfx$Var2))) #get all possible levels of factors
dfx$Var1 <- factor(dfx$Var1, levels=levs)
dfx$Var2 <- factor(dfx$Var2, levels=levs)

接下来我将数据帧分成两部分 - 一个用于 Var1 和 Var1out，一个用于 Var2 和 Var2out：

library(dplyr)
temp.Var1 <- dfx %>% select(Var1, Var1out)
temp.Var2 <- dfx %>% select(Var2, Var2out)

这里我使用model.matrix 按因子级别扩展列：

mat.Var1<-with(temp.Var1, data.frame(model.matrix(~Var1+0)))
mat.Var2<-with(temp.Var2, data.frame(model.matrix(~Var2+0)))

然后，我将每一行的列替换为表示存在该因子的“1”，并使用正确的结果并添加以下矩阵：

mat1 <- apply(mat.Var1, 2, function(x) ifelse(x==1, x<-temp.Var1$Var1out, x<-0)   )
mat2 <- apply(mat.Var2, 2, function(x) ifelse(x==1, x<-temp.Var2$Var2out, x<-0)   )

matX <- mat1+mat2

matX

   Var1A Var1B Var1C Var1D Var1E
1      1     0     0     0    -1
2      0    -1     0     0     1
3      0     0    -1     0     1
4      0     0     0    -1     1
5     -1     1     0     0     0
6      1     0    -1     0     0
7      1     0     0    -1     0
8      0    -1     1     0     0
9      0     1     0    -1     0
10     0     0     1    -1     0

虽然这可行，但我有一种感觉，我可能缺少针对此问题的更简单的解决方案。谢谢。

Answer 1

创建一个空矩阵并使用矩阵索引填充相关值：

cols <- unique(unlist(dfx[1:2]))
M <- matrix(0, nrow = nrow(dfx), ncol = length(cols), dimnames = list(NULL, cols))
M[cbind(sequence(nrow(dfx)), match(dfx$Var1, cols))] <- dfx$Var1out
M[cbind(sequence(nrow(dfx)), match(dfx$Var2, cols))] <- dfx$Var2out
M
#        A  B  C  D  E
#  [1,]  1  0  0  0 -1
#  [2,]  0 -1  0  0  1
#  [3,]  0  0 -1  0  1
#  [4,]  0  0  0 -1  1
#  [5,] -1  1  0  0  0
#  [6,]  1  0 -1  0  0
#  [7,]  1  0  0 -1  0
#  [8,]  0 -1  1  0  0
#  [9,]  0  1  0 -1  0
# [10,]  0  0  1 -1  0

Answer 2

另一种方法是使用acast

 library(reshape2)
  #added `use.names=FALSE` from @Ananda Mahto's comments 
 dfy <- data.frame(Var=unlist(dfx[,1:2], use.names=FALSE), 
            VarOut=unlist(dfx[,3:4], use.names=FALSE), indx=1:nrow(dfx))


 acast(dfy, indx~Var, value.var="VarOut", fill=0)
 #    A  B  C  D  E
 #1   1  0  0  0 -1
 #2   0 -1  0  0  1
 #3   0  0 -1  0  1
 #4   0  0  0 -1  1
 #5  -1  1  0  0  0
 #6   1  0 -1  0  0
 #7   1  0  0 -1  0
 #8   0 -1  1  0  0
 #9   0  1  0 -1  0
 #10  0  0  1 -1  0

或使用spread

 library(tidyr)
 spread(dfy,Var, VarOut , fill=0)[,-1]
 #    A  B  C  D  E
 #1   1  0  0  0 -1
 #2   0 -1  0  0  1
 #3   0  0 -1  0  1
 #4   0  0  0 -1  1
 #5  -1  1  0  0  0
 #6   1  0 -1  0  0
 #7   1  0  0 -1  0
 #8   0 -1  1  0  0
 #9   0  1  0 -1  0
 #10  0  0  1 -1  0