How to calculate adjacency matrices in R
This should at the least get your started. The simplest way I could think of to get the adjacency matrix is to reshape this and then build a graph using igraph as follows:
# load data
df <- read.table(header=T, stringsAsFactors=F, text=" V1 V2 V3
164885 431072 3
164885 164885 24
431072 431072 5")
> df
# V1 V2 V3
# 1 164885 431072 3
# 2 164885 164885 24
# 3 431072 431072 5
# using reshape2's dcast to reshape the matrix and set row.names accordingly
require(reshape2)
m <- as.matrix(dcast(df, V1 ~ V2, value.var = "V3", fill=0))[,2:3]
row.names(m) <- colnames(m)
> m
# 164885 431072
# 164885 24 3
# 431072 0 5
# load igraph and construct graph
require(igraph)
g <- graph.adjacency(m, mode="directed", weighted=TRUE, diag=TRUE)
> E(g)$weight # simple check
# [1] 24 3 5
# get adjacency
get.adjacency(g)
# 2 x 2 sparse Matrix of class "dgCMatrix"
# 164885 431072
# 164885 1 1
# 431072 . 1
# get shortest paths from a vertex to all other vertices
shortest.paths(g, mode="out") # check out mode = "all" and "in"
# 164885 431072
# 164885 0 3
# 431072 Inf 0
Calculate Adjacency Matrix in R from nxm matrix (representing the map)
I think this is what you're after. I'm using igraph version 1 notation.
> packageVersion("igraph")
[1] ‘1.0.1’
The idea is to create a 2D grid and then either remove the blocked nodes or (in this case) remove any edges attached to them.
library(igraph)
# Your grid in matrix form
grid <- rbind(c(0, 0, 0, 0, 0, 0, 0),
c(0, 0, 0, 1, 1, 0, 0),
c(0, 0, 0, 1, 1, 0, 0),
c(0, 0, 1, 1, 1, 0, 0),
c(0, 0, 1, 1, 1, 0, 0),
c(0, 0, 0, 0, 0, 0, 0))
# Make a network on a 2D grid
g <- make_lattice(dimvector=c(nrow(grid), ncol(grid)))
# Add a colour for the nodes we'll be disconnecting
V(g)$color <- c('orange', 'blue')[as.numeric(grid==1)+1]
plot(g)
# Disconnect the inpassable nodes
gGap <- g - E(g)[inc(V(g)[grid==1])]
plot(gGap)
# Either output the adjacency matrix and do your own thing
as_adjacency_matrix(gGap,sparse = FALSE)
# Or find distances in igraph
distances(gGap, v=V(gGap)[1], to=V(gGap), algorithm="dijkstra")
R - finding the neighbors of neighbors and storing them in a unique adjacency matrix
This is a simple summary of the distances table.
library(igraph)
g = graph_from_adjacency_matrix(A, mode = "undirected")
dists = distances(g)
(result = ifelse(dists == 2, 1, 0))
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
# [1,] 0 0 0 0 0 0 0 0 1
# [2,] 0 0 0 0 0 1 0 0 0
# [3,] 0 0 0 1 0 0 0 1 0
# [4,] 0 0 1 0 0 0 0 1 0
# [5,] 0 0 0 0 0 0 0 0 0
# [6,] 0 1 0 0 0 0 0 0 0
# [7,] 0 0 0 0 0 0 0 0 0
# [8,] 0 0 1 1 0 0 0 0 0
# [9,] 1 0 0 0 0 0 0 0 0
And this easily extends to 2 steps away, 3 steps away, etc, however
the distances table will give shortest-path length, so if you look at lengths > 1 and your graph has cycles, this will only look at the shortest path.
Finding the complete adjacency matrix in R
To find the paths from all nodes, it is probably easier to use the igraph package.
Using your example,
library(bnlearn)
library(igraph)
# Create BN in your example
g <- empty.graph(LETTERS[1:5])
amat(g) <- rbind(cbind(0, diag(4)),0)
amat(g)
# A B C D E
# A 0 1 0 0 0
# B 0 0 1 0 0
# C 0 0 0 1 0
# D 0 0 0 0 1
# E 0 0 0 0 0
# Convert to igraph object using BN adj. matrix as input
g1 <- graph_from_adjacency_matrix(amat(g))
# You can find all ancestors for each node by using
# the mode="in" argument, and order to specify the depth of the search
neighborhood(g1, order=nrow(amat(g)), mode="in")
# Similarly, you can get the full connected graph
# using the same options
ances <- connect(g1, order=nrow(amat(g)), mode="in" )
get.adjacency(ances, sparse=FALSE)
# A B C D E
# A 0 1 1 1 1
# B 0 0 1 1 1
# C 0 0 0 1 1
# D 0 0 0 0 1
# E 0 0 0 0 0
Alternatively, you can use matrix exponential
m <- amat(g)
1* as.matrix((Matrix::expm(m) - diag(ncol(m))) > 0)
Creating an Adjacency Matrix in R
We can assign an id column for Case and get the data in wide format. Then use count to count how many times the combination of Plaintiff and Defendant occur.
library(dplyr)
library(tidyr)
df %>%
mutate(Case = dense_rank(Case)) %>%
pivot_wider(names_from = Status, values_from = Person) %>%
count(Plaintiff, Defendant)
# Plaintiff Defendant n
# <int> <int> <int>
#1 11111 44444 1
#2 22222 99999 1
#3 33333 44444 1
#4 44444 99999 1
#5 55555 66666 1
#6 77777 22222 1
#7 99999 11111 1
#8 99999 88888 1
r creating an adjacency matrix from columns in a dataframe
One way is to make the dataset into a "tidy" form, then use xtabs. First, some cleaning up:
df[] <- lapply(df, as.character) # Convert factors to characters
df[df == "NA" | df == "" | is.na(df)] <- NA # Make all blanks NAs
Now, tidy the dataset:
library(tidyr)
library(dplyr)
out <- do.call(rbind, sapply(grep("^Col_Cold", names(df), value = T), function(x){
vars <- c(x, grep("^Col_Hot", names(df), value = T))
setNames(gather_(select(df, one_of(vars)),
key_col = x,
value_col = "value",
gather_cols = vars[-1])[, c(1, 3)], c("cold", "hot"))
}, simplify = FALSE))
The idea is to "pair" each of the "cold" columns with each of the "hot" columns to make a long dataset. out looks like this:
out
# cold hot
# 1 pain infection
# 2 Bump <NA>
# 3 <NA> Callus
# 4 muscle <NA>
# 5 pain medication
# ...
Finally, use xtabs to make the desired output:
xtabs(~ cold + hot, na.omit(out))
# hot
# cold Callus flutter infection medication twitching walking
# Bump 0 1 0 0 1 0
# hemaloma 1 0 1 0 0 0
# muscle 0 1 0 1 2 0
# pain 1 0 2 2 1 1
# sleep 0 0 1 1 0 1
Quickly calculate the number of shared neighbor between any pair of nodes from an adjacency matrix
Yes, you can get the number of shared neighbors by computing the matrix
product of adjm' and adjm. Since you are using R, adjm'*adjm means
the component-wise product of the matrices. We want the matrix product,
so you need to use %*%. I will use that below.
To simplify the notation, I will denote adjm = A where
A[i,j] is 1 if there is a link between nodes i and j (they are neighbors)
and A[i,j] = 0 otherwise.
Let's compute t(A) %*% A.
The i-jth coordinate of t(A) %*% A is
(t(A) %*% A)[i,j] =
sum(t(A)[i,k] * A[k,j]) =
sum(A[k,i] * A[k,j])
All of the products in the sum are either 0 or 1.
If both A[k,i]=1 and A[k,j]=1, the product is 1,
otherwise it is zero. So (t(A)%*%A)[i,j] is equal to the
number of different k's for which both A[k,i]=1 and
A[k,j]=1. But A[k,i]=1 means k is a neighbor of i
and A[k,j]=1 means k is a neighbor of j, so(t(A)%*%A)[i,j] is equal to the number of different k's
for which k is a neighbor of both i and j.
Let's try it out on your example. In order to make the results
reproducible, I set the random.seed.
library(igraph)
## For reproducibility
set.seed(1492)
# create an adj. matrix
adjm <- matrix(sample(0:1, 100, replace=TRUE, prob=c(0.6,0.4)), nc=10)
# set diagonal element to 0
diag(adjm) <- 0
# making it symmetric
adjm[lower.tri(adjm)] = t(adjm)[lower.tri(adjm)]
Shared = t(adjm) %*% adjm
g = graph_from_adjacency_matrix(adjm, mode = "undirected")
plot(g)
Notice for example that Shared[1,4] = 4.
That is because nodes 1 and 4 have four shared neighbors,
Nodes 2,3,6 and 9. Shared[5,7]=0 because nodes 5 and 7
have no neighbors in common.
Create adjacency matrix from a path given as a vector of nodes in base R
You can use the powerful but little-known trick of matrix-based indexing:
index_mat <- rbind(
c(1, 2),
c(2, 3),
c(3, 1)
)
mat <- matrix(FALSE, 3, 3)
mat[index_mat] <- TRUE
mat
[,1] [,2] [,3]
[1,] FALSE TRUE FALSE
[2,] FALSE FALSE TRUE
[3,] TRUE FALSE FALSE
So do this:
path_to_D <- function (path, p) {
indices <- cbind(path[-length(path)], path[-1])
D <- matrix(0, p, p)
D[indices] <- 1
D
}
D <- path_to_D(hypothesis_path, 25)
which(D == 1, arr.ind=TRUE)
row col
[1,] 6 1
[2,] 7 6
[3,] 17 7
Related Topics
How to Create a New Variable in a Data.Frame Based on a Condition
How to Produce a Heatmap with Ggplot2
Extracting a Random Sample of Rows in a Data.Frame with a Nested Conditional
Merge Dataframes on Matching A, B and *Closest* C
Grouping Every N Minutes with Dplyr
Canonical Tidyverse Method to Update Some Values of a Vector from a Look-Up Table
Subset Data.Table by Logical Column
Skip Some Rows in Read.CSV in R
How to Select Non-Numeric Columns Using Dplyr::Select_If
Calling a User-Defined R Function from C++ Using Rcpp
Any Way to Force Fread() of Data.Table Not to Stop on Empty Lines
Quantmod Error 'Cannot Open Url'
Difference Between 'Names(Df[1]) <- ' and 'Names(Df)[1] <- '
Removing Unused Factors from a Facet in Ggplot2