R/do_es.r

Defines functions do_es

Documented in do_es

do_es <- function(data) {
  # require("corpcor")
  # data: data matrix
  out = list()
  m = nrow(data)  ## number of rows
  p = ncol(data)  ## number of columns
  
  #if (is.cate == F) {
  orgn = apply(data, 2, mean)
  orgn = t(t(orgn))
  # if (is.svd == T) {
  data = t(data)
  #  }
  oner = matrix(1, 1, m)
  #     if (is.svd == F) {
  #       cov.data = (1/n) * (t(data - t(oner) %*% t(orgn)) %*% (data - t(oner) %*% t(orgn)))
  #       eig.res = eigen(cov.data)
  #       #   print('cov.data')
  #       #   print(cov.data)
  #       u = eig.res$vectors
  #       d = eig.res$dues
  #       d = t(t(d))
  #     #  out = list()
  #       out$cov = cov.data
  #     } else {
  #    
  
  cen.mat = data - (orgn) %*% (oner)
  # print(t(cen.mat[1:5,1:6]))
  # svd.res = svd(cen.mat)
  #  print(dim(svd.res$u))
  
  svd.res = fast.svd(cen.mat,0)
  u = svd.res$u
  d = svd.res$d
  v = svd.res$v
#  print(length(d))
  #Fix: When objs < vars then current_rank changes and u,d,v are filled with zeros
  if (nrow(data) > ncol(u)) {
    u = cbind(u,matrix(0,nrow(u),nrow(data)-ncol(u)))
    d = c(d,rep(0,nrow(data)-length(d)))
    v = cbind(v,matrix(0,nrow(v),nrow(data)-ncol(v)))
  }
  
  out$v = u

  out$m = m
  out$orgn = orgn
  out$u = v
  out$d = d
  out
} 

Try the idm package in your browser

Any scripts or data that you put into this service are public.

idm documentation built on May 2, 2019, 9:20 a.m.