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表示（在Var1out中放入Player Var1的结果，在Var2out中输入Player Var2）。

期望的输出。

我希望将此数据帧转换为此输出矩阵（行的顺序对我来说并不重要，但正如您可以看到每行引用唯一匹配）：

       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

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

2 个答案: