2015-05-17 48 views
0

公共字我具有以下形式的數據:獲取最大中的R

ID  A1 A2 A3 ... A100 
1  john max karl ... kevin 
2  kevin bosy lary ... rosy 
3  karl lary bosy ... hale 
. 
. 
. 
10000 isha john lewis ... dave 

我想獲得一個ID對於每個ID,使得它們兩者具有共同的屬性(A1,A2的最大數量,。 .A100)

如何在R中執行此操作? 編輯:讓我們叫的輸出MatchId:

ID  MatchId 
1  70 
2  4000 
. 
. 
10000 3000 
+1

它不清楚你想要什麼outp UT。你能舉一個例子嗎? –

+0

@DavidArenburg編輯。 –

+1

您的編輯與所提供的數據集不符。可以說,創建15行數據集並提供與所提供的數據集相對應的期望結果(不是您真正沒有的數據集)更好。 –

回答

2

我認爲這可以讓你在找什麼:

library(dplyr) 

# make up some data 

set.seed(1492) 
rbind_all(lapply(1:15, function(i) { 
    x <- cbind.data.frame(stringsAsFactors=FALSE, i, t(sample(LETTERS, 10))) 
    colnames(x) <- c("ID", sprintf("A%d", 1:10)) 
    x 
})) -> dat 

print(dat) 

## Source: local data frame [15 x 11] 
## 
## ID A1 A2 A3 A4 A5 A6 A7 A8 A9 A10 
## 1 1 H F E C B A R J Z N 
## 2 2 Q P E M L Z C G V Y 
## 3 3 Q J D N B T L K G Z 
## 4 4 D Y U F V O I C A W 
## 5 5 T Z D I J F R C B S 
## 6 6 Q D H U P V O E R N 
## 7 7 C L I M E K N S X Z 
## 8 8 M J S E N O F Y X I 
## 9 9 R H V N M T Q X L S 
## 10 10 Q H L Y B W S M P X 
## 11 11 M N J K B G S X V R 
## 12 12 W X A H Y D N T Q I 
## 13 13 K H V J D X Q W A U 
## 14 14 M U F H S T W Z O N 
## 15 15 G B U Y E L A Q W O 

# get commons 

rbind_all(lapply(1:15, function(i) { 
    rbind_all(lapply(setdiff(1:15, i), function(j) { 
    data.frame(id1=i, 
       id2=j, 
       common=length(intersect(c(t(dat[i, 2:11])), 
             c(t(dat[j, 2:11]))))) 
    })) 
})) -> commons 

commons %>% 
    group_by(id1) %>% 
    top_n(1, common) %>% 
    filter(row_number()==1) %>% 
    select(ID=id1, MatchId=id2) 

## Source: local data frame [15 x 2] 
## Groups: ID 
## 
## ID MatchId 
## 1 1  5 
## 2 2  7 
## 3 3  5 
## 4 4  12 
## 5 5  1 
## 6 6  9 
## 7 7  8 
## 8 8  7 
## 9 9  10 
## 10 10  9 
## 11 11  9 
## 12 12  13 
## 13 13  12 
## 14 14  8 
## 15 15  2 
+0

filter()在做什麼? –

+0

僅取自組中計算的「前n」中的第一個元素。類似於正常數據幀 – hrbrmstr

0

如果我理解正確的話,要求是獲取每個ID共同屬性的最大數量。

頻率表可在使用lapply()table()遞歸來獲得,假設ID列是唯一 - 輕微的修改是必要的,如果不是(unique(df$ID)而非lapply()df$ID)。可以採取最大頻率,並且如果有平局,只選擇第一個頻率。最後它們由do.call()合併。

df <- read.table(header = T, text = " 
ID  A1 A2 A3 A100 
1  john max karl kevin 
2  kevin bosy lary rosy 
3  karl lary bosy hale 
10000 isha john lewis dave") 

do.call(rbind, lapply(df$ID, function(x) { 
    tbl <- table(unlist(df[df$ID == x, 2:ncol(df)])) 
    data.frame(ID = x, MatchId = tbl[tbl == max(tbl)][1]) 
})) 

#   ID MatchId 
#john  1  1 
#kevin  2  1 
#karl  3  1 
#isha 10000  1 
2

使用類似的數據由@hrbrmstr

set.seed(1492) 
dat <- do.call(rbind, lapply(1:15, function(i) { 
    x <- cbind.data.frame(stringsAsFactors=FALSE, i, t(sample(LETTERS, 10))) 
    colnames(x) <- c("ID", sprintf("A%d", 1:10)) 
    x 
})) 

提供你可以達到同樣的使用基礎R僅

Res <- sapply(seq_len(nrow(dat)), 
       function(x) apply(dat[-1], 1, 
       function(y) length(intersect(dat[x, -1], y)))) 
diag(Res) <- -1 
cbind(dat[1], MatchId = max.col(Res, ties.method = "first")) 
# ID MatchId 
# 1 1  5 
# 2 2  7 
# 3 3  5 
# 4 4  12 
# 5 5  1 
# 6 6  9 
# 7 7  8 
# 8 8  7 
# 9 9  10 
# 10 10  9 
# 11 11  9 
# 12 12  13 
# 13 13  12 
# 14 14  8 
# 15 15  2 
+0

的head(df,1)',這裏apply()正在做setdiff()的工作,不是嗎? –

+1

如果您提到@ hrbrmstrs解決方案,我沒有通過它。我想他正在使用'setdiff'來避免比較相同的ID。我沒有這樣做。我正在比較一切,然後運行'diag(Res)< - -1',以確保相同的ID會得到最低值。 –