# Code for Utility functions
# Dont need this eventually..
sourcecpp <- function(){
sourceCpp('/users/nick/desktop/bctR/src/cppUtility.cpp')
}
#' Threshold Proportional
#'
#' This function "thresholds" the connectivity matrix by preserving a
#' proportion p (0<p<1) of the strongest weights. All other weights, and
#' all weights on the main diagonal (self-self connections) are set to 0.
#'
#' Note: For data w/ negative numbers, we consider Absolute Value of weights.
#'
#' @param W : an R Matrix - Weighted Connectivity Matrix
#' @param p : a float - Proportional Weight Threshold
#' @param copy : a boolean - Whether to modify in place or not
#'
#' @return W : Threshold Connectivity Matrix
#'
threshold.proportional <- function(W,
p,
copy=F){
stopifnot(p > 0, p <= 1)
#if (copy) W <- W
n <- nrow(W) # number of nodes
diag(W) <- 0 # clear the diagonal, modifies in place
# if symmetric matrix, ensure symmetry is preserved
s.flag <- F
ud <- 1
if (isSymmetric(W)) {
s.flag <- T
ud <- 2
W[lower.tri(W)] <- 0
}
I <- order(abs(W),decreasing=T) # sort indices by value magnitude
en <- as.integer(round((n*n-n) * p/ud))+1 # num. links to preserve
W[I[en:length(I)]] <- 0 # remove the smallest links
if (s.flag) W <- W + t(W) # add back the lower triangle
return(W)
}
threshold.proportional <- compiler::cmpfun(threshold.proportional)
#' Threshold Absolute
#'
#' This function thresholds the connectivity matrix by absolute weight
#' magnitude. All weights below the given threshold, and all weights
#' on the main diagonal (self-self connections) are set to 0.
#'
#' @param W : an R Matrix - Weighted Connectivity Matrix
#' @param thr : a float - Absolute Weight Threshold
#' @param copy : a boolean - Whether to modify in place or not
#'
#' @return W : Threshold Connectivity Matrix
#'
threshold.absolute <- function(W,
thr,
copy=F){
diag(W) <- 0 # clear the diagonal, modifies in place
W[W < thr] <- 0
return(W)
}
threshold.absolute <- compiler::cmpfun(threshold.absolute)
#' Weight Conversion
#'
#' This function may either binarize an input weighted connection matrix,
#' normalize an input weighted connection matrix or convert an input
#' weighted connection matrix to a weighted connection-length matrix.
#'
#' Binarization converts all present connection weights to 1.
#'
#' Normalization scales all weight magnitudes to the range [0,1] and
#' should be done prior to computing some weighted measures, such as the
#' weighted clustering coefficient.
#'
#' Conversion of connection weights to connection lengths is needed
#' prior to computation of weighted distance-based measures, such as
#' distance and betweenness centrality. In a weighted connection network,
#' higher weights are naturally interpreted as shorter lengths. The
#' connection-lengths matrix here is defined as the inverse of the
#' connection-weights matrix.
#'
#' Options for 'wcm' param:
#' 'binarize' : binarize weights
#' 'normalize' : normalize weights
#' 'lengths' : convert weights to lengths (invert matrix)
#'
#' @param W : an R Matrix - Weighted Connectivity Matrix
#' @param wcm : a string - Weight Conversion Command
#'
#' @return W : an R Matrix - Connectivity Matrix with
#' specified changes
#'
weight.conversion <- function(W,
wcm,
copy=F){
stopifnot(wcm %in% c('binarize','normalize','lengths'))
if (wcm == 'binarize'){
W <- binarize(W)
}
else if (wcm == 'normalize'){
W <- normalize(W)
}
else if (wcm == 'lengths'){
W <- invert(W)
}
}
#' Binarize
#'
#' Binarizes an input weighted connection matrix,
#' i.e. any value > 0 gets set to 1
#'
#' @param W : an R matrix - weighted connectivity matrix
#' @param copy : boolean
#'
#' @return W : an R matrix - binary weighted connectivity matrix
#'
binarize <- function(W,
copy=F){
W[W!=0] <- 1
return(W)
}
#' Normalize
#'
#' Normalizes an input weighted connection matrix,
#' i.e. divides each value by the abs. max. value in matrix
#'
#' @param W : an R matrix - weighted connectivity matrix
#' @param copy : boolean
#'
#' @return W : an R matrix - normalized weighted connectivity matrix
#'
normalize <- function(W,
copy=F){
W <- W / max(abs(W))
return(W)
}
#' Invert
#'
#' Inverts elementwise the weights in an input connection matrix,
#' i.e. changes W from a matrix of internode strengths to
#' a matrix of internode distances
#'
#' @param W : an R matrix - weighted connectivity matrix
#' @param copy : boolean
#'
#' @return W : an R matrix - inverted weighted connectivity matrix
#'
invert <- function(W,
copy=F){
W[which(W>0)] <- 1 / W[which(W>0)]
return(W)
}
#' Autofix
#'
#' Fix a bunch of common problems.
#' More specifically, remove Inf and NaN, ensure
#' exact binariness and symmetry (i.e. remove floating point
#' instability), and zero diagonal.
#'
#' @param W : an R matrix - weighted connectivity matrix
#' @param copy : boolean
#'
#' @return W : an R matrix - autofixed weighted connectivity matrix
#'
autofix <- function(W,
copy=F){
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.