R/generics.R

In jinzhuangdou/SCCAT: Simultaneous Canonical Correlation Analysis on Two directions \

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# Functions
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#' L2 normalize the columns (or rows) of a given matrix
#' @param mat Matrix to cosine normalize
#' @param MARGIN Perform normalization over rows (1) or columns (2)
#'
#'
#' @return returns l2-normalized matrix
#'
#'

L2Norm <- function(mat, MARGIN = 1){
  normalized <- sweep(
    x = mat,
    MARGIN = MARGIN,
    STATS = apply(
      X = mat,
      MARGIN = MARGIN,
      FUN = function(x){
        sqrt(x = sum(x ^ 2))
      }
    ),
    FUN = "/"
  )
  normalized[!is.finite(x = normalized)] <- 0
  return(normalized)
}


#' Normalize the columns of a given matrix
#' @param mat Matrix to normalize
#'
#' @return returns column-normalized matrix
#'
#'

colScale <- function(X){

    X <- scale(X, TRUE, apply(X,2,sd))
    return(X)
}


#' Normalize the rows of a given matrix
#' @param mat Matrix to normalize
#'
#' @return returns row-normalized matrix
#'
#'

rowScale <- function(X){
    tp <- t(X) 
    tp <- scale(tp, TRUE, apply(tp,2,sd))
    X  <- t(tp)
    return(X)
}


#' Matrix Crossproduct
#' Given a list of matrices x1, x2, ... , xn as arguments, return a matrix cross-product. 
#' x1%*%x2%*%xn
#' @param lst list of matrix
#'
#' @return returns crossproduct
#'
#'

mulitCrossprod <- function(lst){
    n <- length(lst)
    out <- lst[[1]]
    for(i in seq(2, n, 1)){
        out <- crossprod(t(out), lst[[i]])
    }
    return(out)
}

#' tests if its argument is a sparse matrix.
#' @param x  matrix to be tested
#'
#' @return returns TRUE if matrix is sparse and FALSE otherwise
#'
#'

is.sparseMatrix <- function(x) is(x, 'sparseMatrix') 



feature_match <- function(dt1, dt2,  band.width=10){
    out <- cdist(dt1, dt2)
    out <- as.matrix(out)
    for( i in seq(1, dim(out)[2],1)){
        out[,i] <- exp(0-band.width*out[,i]/sd(out[,i]))
        out[,i] <- out[,i]/sum(out[,i])
    }
    out[out<10^(-7)] <- 0
    out <- Matrix(out, sparse = TRUE)
    return(out)
}