將存在/不存在矩陣轉換為頂點連接的 Data.frame。 （刪除具有 eeuqal 無序值的重復行）

Question

我有一個矩陣表，其中行表示一個站點，列表示特定岩石的存在/不存在。

>Mat
       A   B   C   D   E   F   G
Aiz    1   0   0   0   0   0   0
Aren   0   1   1   0   1   0   0
Atx    0   0   1   0   1   0   0
Berr   1   1   0   0   0   1   0
Bra    0   0   0   0   0   1   0
Bur    0   1   0   0   1   0   0
Cab    1   0   1   1   1   0   0

如您所見，有些行在某些列中具有相同的元素，例如。 行Aiz和行Berr在A列中共享一個存在，這表明在我的示例中它們共享同一塊岩石。

從這個矩陣我想構建一個無向圖，其中節點是站點（行名），鏈接是列元素的份額。

所以，基本上，我需要將這個矩陣轉換為樣式的data.frame：

>DF
   siteA    siteB weight
1    Aiz    Berr     1
2    Aiz     Cab     1
3   Aren   Atxos     2
4   Aren    Berr     1
5   Aren     Bur     2       
6   Aren     Cab     1
7    Atx     Bur     1
...

其中每一行標識共享相同岩石的兩個站點（存在於原始Mat的同一列中）和列weight ，表示兩個站點共有的岩石數量。

因此，通過一系列嵌套for loops和if條件，我設法接近DF矩陣，盡管我的DF具有重復結果的行，例如：

> df_links
   siteA    siteB weight
1    Aiz    Berr     1
2    Aiz     Cab     1
3   Aren   Atxos     2
4   Berr     Aiz     1
5  Atxos    Aren     2

您在哪里看到，例如： row 1 row 4 （ row 3 row 5相同）共享站點列的相同元素。 並且由於這是一個無向圖，具有 Aiz-Berr 或 Ber-Aiz 意味着相同，因此我只需要其中一個行。

Q 1：所以，我嘗試用tidyverse解決重復問題，但似乎沒有任何效果。 充其量我只會刪除其中一個重復的行，而不是全部。 所以，我的問題是，有沒有辦法可以做到這一點？ 無論順序如何，只保留具有相同元素[i,j]的行之一？

Q 2：這個可能比較麻煩，所以排在第二位。 即使我的代碼有效（直到第一季度上面指出的問題），它也不是最漂亮的。 矩陣到 data.frames 到 data.frames 的序列是否帶有for loops和條件。從原始Mat到所需的DF是否有 go 的更整潔的版本？ 我不太熟悉sapply和整個家庭，所以我使用了循環。 有更快更好看的解決方案嗎？

Answer 1

要刪除 2 個可互換列的重復條目，首先重新排序，然后刪除 dataframe 的重復行。

df_links <- transform(df_links, siteA = pmin(siteA, siteB), 
                  siteB = pmax(siteA, siteB))
unique(df_links)
#  siteA siteB weight
#1   Aiz  Berr      1
#2   Aiz   Cab      1
#3  Aren Atxos      2

為了避免在無向圖中刪除重復的頂點對，您可以使用dist function，這在處理向量對之間的相似性時非常有用。 當您將相似度（或權重）定義為站點（或向量）之間的常見岩石數量時，您需要傳遞自定義 function，這可以使用 package代理中的dist來完成。

#The similarity is the number of matching '1'
similarityMatrix <- as.matrix(proxy::dist(Mat, method = function(x,y){
  length(which(x+y==2))
}))
similarityMatrix
#     Aiz Aren Atx Berr Bra Bur Cab
#Aiz    0    0   0    1   0   0   1
#Aren   0    0   2    1   0   2   2
#Atx    0    2   0    0   0   1   2
#Berr   1    1   0    0   1   1   1
#Bra    0    0   0    1   0   0   0
#Bur    0    2   1    1   0   0   1
#Cab    1    2   2    1   0   1   0

在那里，您在所有站點對之間都有一個相似性矩陣。 由於您要構建的圖形是無向的，因此您需要從該矩陣中的 select 每對僅一次。

#Unique pairwise combinations of different vectors
combinations <- t(combn(colnames(similarityMatrix), 2))
pairwiseSites <- data.frame(combinations, similarityMatrix[combinations])

colnames(pairwiseSites) <- c("siteA", "siteB", "weight")

pairwiseSites
#   siteA siteB weight
#1    Aiz  Aren      0
#2    Aiz   Atx      0
#3    Aiz  Berr      1
#4    Aiz   Bra      0
#5    Aiz   Bur      0
#6    Aiz   Cab      1
#7   Aren   Atx      2
#8   Aren  Berr      1
#9   Aren   Bra      0
#10  Aren   Bur      2
#11  Aren   Cab      2
#12   Atx  Berr      0
#13   Atx   Bra      0
#14   Atx   Bur      1
#15   Atx   Cab      2
#16  Berr   Bra      1
#17  Berr   Bur      1
#18  Berr   Cab      1
#19   Bra   Bur      0
#20   Bra   Cab      0
#21   Bur   Cab      1

---

原始數據

Mat <- read.table(header=TRUE, text="
A   B   C   D   E   F   G
Aiz    1   0   0   0   0   0   0
Aren   0   1   1   0   1   0   0
Atx    0   0   1   0   1   0   0
Berr   1   1   0   0   0   1   0
Bra    0   0   0   0   0   1   0
Bur    0   1   0   0   1   0   0
Cab    1   0   1   1   1   0   0")

df_links <- read.table(header=TRUE, text="
siteA    siteB weight
1    Aiz    Berr     1
2    Aiz     Cab     1
3   Aren   Atxos     2
4   Berr     Aiz     1
5  Atxos    Aren     2")

Answer 2

該問題可以使用 purrr package 解決。

# reproduce input
mat <- matrix(
  data = c(1,0,0,0,0,0,0,
           0,1,1,0,1,0,0,
           0,0,1,0,1,0,0,
           1,1,0,0,0,1,0,
           0,0,0,0,0,1,0,
           0,1,0,0,1,0,0,
           1,0,1,1,1,0,0), nrow = 7, ncol = 7)
colnames(mat) <- LETTERS[1:7]
rownames(mat) <- c("Aiz", "Aren", "Atx", "Berr", "Bra", "Bur", "Cab")

# convert to dataframe
df <- mat %>% 
  dplyr::as_tibble() %>% 
  dplyr::bind_cols(
    tibble::tibble(Names = rownames(mat)))

# calculate the connections
purrr::map_df(df$Names, function(x){
  output <-purrr::map_df(df$Names, function(y){
    if(x >= y) return(tibble::tibble()) # avoid double counting
    tibble::tibble(
      siteA = x,
      siteB = y,
      weight = sum(as.integer(df[df$Names==x,1:7]) & as.integer(df[df$Names==y,1:7])))
    })
  })

祝你好運