2014-10-18 87 views
1

說我有以下數據框:轉化成數據幀矩陣擴展中的R

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 

你在這裏看到什麼是相當於由巔峯對決的玩家A,B,C,d和E之間,他們10行每場比賽一場,每場比賽的勝者用+1表示,每場比賽的輸家都用-1表示(分別放在Var1out中的玩家Var1結果,Var2out中的玩家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 

雖然這有效,但我有一種感覺,我可能會錯過這個問題的更簡單的解決方案。謝謝。

回答

2

創建一個空矩陣和使用矩陣索引填寫相關的值:

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 
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 
+0

看到後這個答案,我意識到如果OP不介意重命名他們的列,他們可以使用'merged.st ack'從我的「splitstackshape」包。請參閱[本摘要](https://gist.github.com/mrdwab/98175d209b642ee39ae9),以及時間安排。 – A5C1D2H2I1M1N2O1R2T1 2014-10-18 10:54:20

+0

@Ananda Mahto感謝時間。 「傳播」並不是那麼快,我有點驚訝。也許,'dcast.data.table'會是一個更好的選擇。 – akrun 2014-10-18 10:56:46

+0

目前,在你的函數中大約45%的時間都用在「unlist」步驟中。 ***'use.names = FALSE'大大降低了*** ......但仍然沒有抵制矩陣索引方法的機會:-) – A5C1D2H2I1M1N2O1R2T1 2014-10-18 11:06:28