R/TransformX.R

In sambiostat/WAPL: What the Package Does (One Line, Title Case)

#' reform X
#' Due to the use of group, this function can reform the feature matrix
#' @param z: n by d*p vectors;
#' @param group: length p vectors indicating which x belongs to which group;
#' @param maxsize: maximum number of features in one group
#' @param ngroup: number of group
#' @param d: number of basis
#' @param p: number of feature
reformX <- function(z, group, maxsize, ngroup, d, p){
  blocksize <- maxsize*p

  newz = matrix(0, nrow=nrow(z), ncol=blocksize*ngroup)
  for (i in as.data.frame(table(group))[,"group"]){
    i=as.numeric(i)
    tmp =  blocksize*(i - 1) + c(1: blocksize)
    xidx = which(group==i)
    zidx = Reduce(c, sapply(xidx, function(s)(s - 1) * p + c(1:p)))
    if (length(zidx) < blocksize){
      newz[,tmp]=cbind(z[,zidx], matrix(0, nrow=nrow(z), ncol= blocksize-length(zidx)))
    }else{
      newz[,tmp] = z[,zidx]
    }
  }
  return(newz)
}


#' reform X
#' Can be viewed as the inverse function of reformX
#' @param newW: n by d*p vectors;
#' @param group: length p vectors indicating which x belongs to which group;
#' @param maxsize: maximum number of features in one group
#' @param ngroup: number of group
#' @param d: number of basis
#' @param p: number of feature
DeformCoef <- function(newW, group, maxsize, ngroup, d, p){
  #x: n by d*p vectors;
  #group: length p vectors indicating which x belongs to which group;
  blocksize <- maxsize*p
  oldw = matrix(NA, ncol=ncol(newW), nrow=p*d+1)
  #Intercep won't change
  oldw[p*d+1, ] = newW[p*d+1, ]
  for (i in as.data.frame(table(group))[,"group"]){
    i = as.numeric(i)
    xidx = which(group==i)
    zidx = Reduce(c, sapply(xidx, function(s)(s - 1) * p + c(1:p)))
    tmp =  blocksize*(i - 1) + c(1: (length(xidx)*p))
    oldw[zidx, ] = newW[tmp, ]
  }
  return(oldw)
}