# ---- Internal Functions ----
as_binary <- function(sociomatrix){
return(matrix(as.numeric(as.logical(sociomatrix)),nrow = nrow(sociomatrix)))
}
check_input <- function(sociomatrix, path, source, target, p_norm){
# Check sociomatrix
if(!is.matrix(sociomatrix)){
stop("'sociomatrix' must be class 'matrix'")
}
if(!is.numeric(sociomatrix)){
stop("'sociomatrix' must be type 'numeric'")
}
dims <- dim(sociomatrix)
if(dims[1] != dims[2]){
stop("'sociomatrix' must be square")
}
actors <- 1:(dims[1]) # used in checking path
# Check path or source & target, as necessary
if(!is.null(path)){
for(actor in path){
if(!(actor %in% actors)){
stop("All elements of 'path' must correspond to actor indices in 'sociomatrix'")
}
}
}else{ # if there is no path provided, we use source and target nodes
if(is.null(source) || is.null(target)){
stop("Either a path of vertices or a source and target vertex must be provided")
}
if((length(source) != 1) || (length(target) != 1)){
stop("'source' and 'target' must be unique")
}
if(!((source %in% actors) && (target %in% actors))){
stop("'source' and 'target' must both correspond to vertex indices in 'sociomatrix'")
}
}
# Check p_norm
if(!(is.numeric(p_norm) && (length(p_norm) == 1))){
stop("'p_norm' must be a unique numeric")
}
if(p_norm < 0){
stop("'p_norm' must be nonnegative")
}
}
# Dijkstra Function
shortest_path <- function(distance_matrix, source, target, p_norm){
if(p_norm == Inf){
prev <- dijkstra_inf(distance_matrix, source - 1) + 1 #adjusting for Cpp indices
} else {
prev <- dijkstra((distance_matrix^p_norm), source - 1) + 1 #adjusting for Cpp indices
}
if(is.na(prev[target])){
path <- NA # path is disconnected
} else {
# Now walk backwards through 'prev'
on <- target
path <- c(on)
while(on != source){
on <- prev[on]
path <- c(on, path)
}
}
return(path)
}
get_tie_strengths <- function(sociomatrix, path){
if(is.na(path[1])){return(0)} # If path does not exist, tie_striength = 0
tie_strength <- rep(0,(length(path) - 1))
for(i in 1:(length(path)-1)){
on <- path[i]; to <- path[i + 1];
tie_strength[i] <- sociomatrix[on,to]
}
return(tie_strength)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.