R/auxiliary.R

In kisungyou/PNAS: 'PNAS' is for Network Analysis and Statistical methods

# Auxiliary Functions
# (1) check_network : check whether input is a network/adjacency, directed allowed
# (2) aux_geigen    : my taste
# (3) aux_pinv      : from Rdimtools



# (1) check_network -------------------------------------------------------
#' @keywords internal
#' @noRd
check_network <- function(input, allow.directed = TRUE){
  if (inherits(input, "igraph")){
    if (allow.directed){
      return(TRUE)
    } else {
      adjmat = as.matrix(igraph::as_adjacency_matrix(input))
      if (isSymmetric(adjmat)){
        return(TRUE)
      } else {
        return(FALSE)
      }
    }
  } else if (is.matrix(input)){
    cond1 = (nrow(input)==ncol(input))
    cond2 = (all(input >= 0))
    if (allow.directed){
      if (cond1&&cond2){
        return(TRUE)
      } else {
        return(FALSE)
      }
    } else {
      cond3 = isSymmetric(input)
      if (cond1&&cond2&&cond3){
        return(TRUE)
      } else {
        return(FALSE)
      }
    }
  } else {
    stop("* input should be either 'igraph' object or adjacency matrix.")
  }
}


# (2) aux_geigen ----------------------------------------------------------
#' @keywords internal
#' @noRd
aux_geigen <- function(A,B,decreasing=TRUE){
  tmpout = geigen::geigen(A,B) # increasing order

  gvals  = tmpout$values
  gvecs  = tmpout$vectors
  nnn    = length(gvals)
  
  if (decreasing){
    gvals = gvals[nnn:1]
    gvecs = gvecs[,nnn:1]
  }
  
  return(list(values=gvals,vectors=gvecs))
}


# (3) aux_pinv ------------------------------------------------------------
# https://en.wikipedia.org/wiki/Moore%E2%80%93Penrose_inverse#Singular_value_decomposition_(SVD)
#' @keywords internal
#' @noRd
aux_pinv <- function(A){
  svdA      = base::svd(A)
  tolerance = (.Machine$double.eps)*max(c(nrow(A),ncol(A)))*as.double(max(svdA$d))
  
  idxcut    = which(svdA$d <= tolerance)
  invDvec   = (1/svdA$d)
  invDvec[idxcut] = 0
  
  output = (svdA$v%*%diag(invDvec)%*%t(svdA$u))
  return(output)
}