Hi Victoria,
This reply is likely 6 years too late. But I recently asked the exact same question. Since I couldn't find anyone else who had done the work, I decided to write it based on Robert's suggestion. Here is what I wrote. Hopefully, it will be helpful to someone else.
To use it, just put in an adjacency matrix and specify pathlength (i.e. 3). You should get a vector back of all of the possible paths. For me, I wasn't interested in paths where you back track and visit a node more than once, so I included a backtrack flag to specify where you care about back tracking or not.
HTH,
Ken
=== code ===
findPath <- function(adj.matrix, pathlengths, backtrack=F, plot=F){
if(plot){
require(Rgraphviz)
testgraph <- new("graphAM", adj.matrix, edgemode="directed")
plot(testgraph, attrs=list(node =list(fillcolor="lightblue"), edge=list(arrowsize=0.5)))
}
converted.path.matrix <- matrix("", nrow=nrow(adj.matrix), ncol=ncol(adj.matrix))
path.matrix <- matrix("", nrow=nrow(adj.matrix), ncol=ncol(adj.matrix))
for (i in 1:nrow(adj.matrix)){
for (j in 1:ncol(adj.matrix)){
if (adj.matrix[i,j] == 1) {
converted.path.matrix[i,j] <- paste(c(i,j), collapse=",")
path.matrix[i,j] <- j
}
}
}
new.path.matrix = converted.path.matrix
if (pathlengths == 1)
return(as.vector(return_paths(new.path.matrix, backtrack)))
if (pathlengths > 1){
for (n in 2:pathlengths){
new.path.matrix <- matrix_combine(new.path.matrix, path.matrix)
}
}
return(as.vector(return_paths(new.path.matrix, backtrack)))
}
# A and B both matrix
matrix_combine <- function(A, B){
#data checks
if (!is.matrix(A) | !is.matrix(B))
stop ("A needs to be a matrix, B needs to be a matrix")
if (ncol(A) != nrow(B) | nrow(A) != ncol(B))
stop ("Incompatible matrix dimensions between A and B!")
result <- matrix("", nrow=nrow(A), ncol=ncol(B))
for (i in 1:ncol(A)){
#print(paste("i=", i))
for (j in 1:nrow(A)){
#print(paste("j=", j))
temp <- NULL
for (k in 1:ncol(A)){
#print(paste("k=", k))
temp <- c(temp, combine_paths(A[i,k], B[k,j]))
}
temp2 <- lapply(temp, function(x){
junk <- NULL
if (x != ""){
junk <- c(junk, x)
}
junk
})
temp2 <- paste(unlist(temp2), collapse="/")
result[i,j] <- temp2
}
}
result
}
combine_paths <- function(x,y){
result <- ""
counter <- 1
for (i in unlist(strsplit(as.character(x), split="/"))) {
for (j in y){
if (i != "" & j != "" & counter != 1){
result <- c(result, paste(c(i,j), collapse=","))
} else if (i != "" & j != "" & counter == 1){
result <- paste(c(i,j), collapse=",")
}
counter = counter + 1
}
}
if (length(result) > 1) return(paste(result, collapse="/"))
return(result)
}
return_paths <- function(path.matrix, backtrack=F){
result <- NULL
if (is.matrix(path.matrix)){
for (i in 1:nrow(path.matrix)){
for (j in 1:ncol(path.matrix)){
if (path.matrix[i,j] != ""){
result <- c(result, strsplit(path.matrix[i,j], split="/"))
}
}
}
}
result <- unique(sort(unlist(result)))
if (!backtrack) {
unlist(sapply(result, function(x){
temp <- unlist(strsplit(x, split=","))
if( length(unique(temp)) != length(temp)) return(NULL)
x
}))
} else {
result
}
}
Use of this site constitutes acceptance of our User Agreement and Privacy Policy.