Romain
Romain

Reputation: 77

Convert nearest neighbours list into a binary adjacency matrix in r

I have a list of 24 sites near_neigh, along with the 3 nearest neighbours for all sites amongst these sites. The first column lists the sites, the other columns list the 3 neigbours.

near_neigh <- 
structure(list(row.names.near_neigh. = c("1", "2", "3", "4", 
"5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", 
"16", "17", "18", "19", "20", "21", "22", "23", "24"), 
nn.index.1 = c(6L, 
7L, 2L, 5L, 6L, 1L, 2L, 9L, 8L, 7L, 8L, 14L, 16L, 17L, 19L, 20L, 
18L, 17L, 22L, 23L, 17L, 19L, 20L, 23L), 
nn.index.2 = c(2L, 1L, 
7L, 8L, 4L, 7L, 6L, 4L, 5L, 6L, 9L, 13L, 15L, 18L, 20L, 13L, 
21L, 21L, 20L, 19L, 18L, 23L, 22L, 16L), 
nn.index.3 = c(7L, 3L, 
1L, 9L, 9L, 5L, 10L, 11L, 6L, 9L, 14L, 16L, 20L, 21L, 13L, 15L, 
14L, 14L, 15L, 22L, 14L, 20L, 19L, 21L)), 
class = "data.frame", row.names = c(NA, 
-24L))

I would like to turn this list into a binary adjecency matrix of 24x24 describing the neighbours for all sites.

Upvotes: 2

Views: 610

Answers (2)

G. Grothendieck
G. Grothendieck

Reputation: 269674

1) Create an nr by nr zero matrix and use Reduce to successively insert 1's from each column.

nr <- nrow(near_neigh)
f <- function(m, x) replace(m, cbind(1:nr, x), 1)
Reduce(f, init = matrix(0, nr, nr), near_neigh[-1])

2) or using a loop over the index columns:

nr <- nrow(near_neigh)
m <- matrix(0, nr, nr)
for(x in near_neigh[-1]) m[cbind(1:nr, x)] <- 1

3) or loop over the rows:

nr <- nrow(near_neigh)
m <- matrix(0, nr, nr)
for(i in 1:nr) m[i, unlist(near_neigh[i, -1])] <- 1

4) or using igraph

library(tidyr)
library(igraph)

set.seed(7)

edgelist <- sapply(pivot_longer(near_neigh, -1)[-2], as.numeric)
g <- graph_from_edgelist(edgelist, directed = FALSE)
mm <- as_adjacency_matrix(g)  # class  "dgCMatrix"

# rest is optional but converting to unnamed matrix allows comparison
# to other solutions

mm <- as.matrix(mm)
dimnames(mm) <- NULL

plot(g, vertex.shape = "none")

screenshot

Upvotes: 2

Aur&#232;le
Aur&#232;le

Reputation: 12819

A graph approach using igraph:

near_neigh <- sapply(near_neigh, as.integer) 

library(igraph)

g <- graph_from_edgelist(rbind(near_neigh[, c(1, 2)],
                               near_neigh[, c(1, 3)],
                               near_neigh[, c(1, 4)]),
                         directed = TRUE)

plot(g)

enter image description here

as.matrix(as_adjacency_matrix(g))
      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14] [,15] [,16] [,17] [,18] [,19] [,20] [,21] [,22] [,23] [,24]
 [1,]    0    1    0    0    0    1    1    0    0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0
 [2,]    1    0    1    0    0    0    1    0    0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0
 [3,]    1    1    0    0    0    0    1    0    0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0
 [4,]    0    0    0    0    1    0    0    1    1     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0
 [5,]    0    0    0    1    0    1    0    0    1     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0
 [6,]    1    0    0    0    1    0    1    0    0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0
 [7,]    0    1    0    0    0    1    0    0    0     1     0     0     0     0     0     0     0     0     0     0     0     0     0     0
 [8,]    0    0    0    1    0    0    0    0    1     0     1     0     0     0     0     0     0     0     0     0     0     0     0     0
 [9,]    0    0    0    0    1    1    0    1    0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0
[10,]    0    0    0    0    0    1    1    0    1     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0
[11,]    0    0    0    0    0    0    0    1    1     0     0     0     0     1     0     0     0     0     0     0     0     0     0     0
[12,]    0    0    0    0    0    0    0    0    0     0     0     0     1     1     0     1     0     0     0     0     0     0     0     0
[13,]    0    0    0    0    0    0    0    0    0     0     0     0     0     0     1     1     0     0     0     1     0     0     0     0
[14,]    0    0    0    0    0    0    0    0    0     0     0     0     0     0     0     0     1     1     0     0     1     0     0     0
[15,]    0    0    0    0    0    0    0    0    0     0     0     0     1     0     0     0     0     0     1     1     0     0     0     0
[16,]    0    0    0    0    0    0    0    0    0     0     0     0     1     0     1     0     0     0     0     1     0     0     0     0
[17,]    0    0    0    0    0    0    0    0    0     0     0     0     0     1     0     0     0     1     0     0     1     0     0     0
[18,]    0    0    0    0    0    0    0    0    0     0     0     0     0     1     0     0     1     0     0     0     1     0     0     0
[19,]    0    0    0    0    0    0    0    0    0     0     0     0     0     0     1     0     0     0     0     1     0     1     0     0
[20,]    0    0    0    0    0    0    0    0    0     0     0     0     0     0     0     0     0     0     1     0     0     1     1     0
[21,]    0    0    0    0    0    0    0    0    0     0     0     0     0     1     0     0     1     1     0     0     0     0     0     0
[22,]    0    0    0    0    0    0    0    0    0     0     0     0     0     0     0     0     0     0     1     1     0     0     1     0
[23,]    0    0    0    0    0    0    0    0    0     0     0     0     0     0     0     0     0     0     1     1     0     1     0     0
[24,]    0    0    0    0    0    0    0    0    0     0     0     0     0     0     0     1     0     0     0     0     1     0     1     0

Upvotes: 1

Related Questions